|
QQ:1584564464 ,急,以下太深奥了,不会修改应用,请求支援
Sub TEST()
P = InputBox("需要填写多少张表格", "表格张数", 1)
If P = "" Or P < 1 Then Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each SH In Sheets '删除旧表
If IsNumeric(SH.Name) And SH.Name <> "000" Then SH.Delete
Next
For I = 1 To P
Sheets("000").Copy AFTER:=Sheets(Sheets.Count) '添加表
S = 5 '填表行
N = Format(I, "000") '表编号
With ActiveSheet
.Name = N
.Range("D4") = "050406" & N '证书编号
For M = 2 To Sheets("资料").Range("A65536").End(3).Row
If Sheets("资料").Cells(M, 1) = N Then
S = S + 1
.Cells(S, 3) = Sheets("资料").Cells(M, 2)
.Cells(S + 11, 3) = Sheets("资料").Cells(M, 2)
For J = 4 To 5
.Cells(S, J) = Sheets("资料").Cells(M, J)
.Cells(S + 11, J) = Sheets("资料").Cells(M, J)
Next
.Cells(S, 6) = Sheets("资料").Cells(M, 7)
.Cells(S + 11, 6) = Sheets("资料").Cells(M, 6)
End If
Next
End With
If S = 5 Then Sheets(N).Delete '没有该户编号则删除
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "运行完毕!"
End Sub
|
|