做过一个拆分工资条的。可以按照A列的姓名将每个人的工资单独存放在工作簿中。
Sub 工资条()
Dim rg As Range
Dim x As Integer
Dim rg1 As Range
Dim wst As Worksheet
Set wst = Sheets("源数据")
Set rg1 = wst.Range("a1").EntireRow
Set rg = wst.Range("a2").EntireRow
Dim tit As String
For x = 2 To wst.Range("a1").End(xlDown).Row
If wst.Range("a" & x + 1) = wst.Range("a" & x) Then
Set rg = Union(rg, wst.Range("a" & x + 1).EntireRow)
Else
tit = wst.Range("a" & x).Value
Workbooks.Add
ActiveWorkbook.Title = tit
ActiveWorkbook.SaveAs Filename:="D:\" & tit & ".xlsx"
rg1.Copy ActiveSheet.Range("a1")
rg.Copy ActiveSheet.Range("a2")
ActiveWorkbook.Save
ActiveWindow.Close
Set rg = wst.Range("a" & x + 1).EntireRow
End If
Next
MsgBox "工资条已经生成完毕!数据存储在D盘!"
Shell "explorer D:\"
End Sub
本回答被网友采纳