|
Sub 分表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Index > 2 Then
sh.Delete
End If
Next sh
Application.DisplayAlerts = True
With Sheets("明细台账")
r = .Cells(Rows.Count, 4).End(xlUp).Row
ar = .Range("c1:h" & r)
End With
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" Then
Sheets("模版").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = ar(i, 2)
For j = 2 To 6
.Cells(j, 4) = ar(i, j)
Next j
End With
End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|