请教各位大师，如何根据分表的模板，批量产生分表？详见附件

gzmosun1

请教各位大师，如何根据分表的模板，批量产生分表？详见附件

excelhomezql

1. Sub x()
   
2. Dim wt As Worksheet, i As Integer
   
3. Set wt = Worksheets(1)
   
4. i = 3
   
5. Do While wt.Range("B" & i) <> ""
   
6. Worksheets.Add(after:=Worksheets(i - 1)).Name = wt.Range("B" & i).Value
   
7. Worksheets(2).Range("A1").CurrentRegion.Copy Worksheets(i).Range("A1")
   
8. Worksheets(i).Range("A2") = wt.Range("A" & i)
   
9. Worksheets(i).Range("A4") = wt.Range("B" & i)
   
10. i = i + 1
    
11. Loop
    
12. End Sub
    

复制代码

gzmosun1

excelhomezql 发表于 2018-6-22 15:09

谢谢！非常感谢1

lsc900707

一个名称两个代码就会报错，运行代码前请先规范一下：

1. Sub gj23w98()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     For Each Sht In Sheets
   
5.         If Sht.Name <> ActiveSheet.Name And Sht.Name <> "模板" Then Sht.Delete
   
6.     Next
   
7.     Application.DisplayAlerts = True
   
8.     arA = [a1].CurrentRegion
   
9.     For i = 2 To UBound(arA)
   
10.         Sheets("模板").Copy after:=Sheets(Sheets.Count)
    
11.         With ActiveSheet
    
12.             .Name = arA(i, 2)
    
13.             .[a2] = arA(i, 1): .[a4] = arA(i, 2)
    
14.         End With
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码

lsc900707

参考附件：