|
在11楼的基础上,合并了同名内容,共60多个工作表。
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
lastrow = [a65536].End(xlUp).Row
arr = Range("A1:A" & lastrow)
startrow = 3
For i = 1 To lastrow
If Trim(arr(i, 1)) = "合计" Then
d(arr(startrow, 1)) = i
startrow = i + 1
End If
Next
k = d.keys
For m = 0 To d.Count - 1
Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
sht.Name = k(m)
Next
startrow = 3
For i = 1 To lastrow
If Trim(arr(i, 1)) = "合计" Then '通过"合计"来判断从哪一行开始拆分
If d.exists(arr(startrow, 1)) Then
Set sht = Sheets(arr(startrow, 1))
If sht.Range("A3") = "" Then
Range("A1:L2").Copy sht.Range("A1")
Range("A" & startrow).Resize(i - startrow + 1, 12).Copy sht.Range("A3")
startrow = i + 1
Else
Range("A" & startrow).Resize(i - startrow + 1, 12).Copy sht.Range("A" & sht.Range("a65536").End(3).Row)
startrow = i + 1
End If
End If
End If
Next
Application.ScreenUpdating = True
End Sub |
|