求大神帮忙根据一张数据自动生成多张表问题

看灰灰灰灰灰机

按照表一固定的格式，根据表二数据，自动生成多个以姓名为名的工作表，谢谢好心的大神！

719404338

1. Sub t()
   
2. 
   
3. Dim i%
   
4.    For i = 2 To Sheet2.[a66536].End(3).Row
   
5.     Sheets("Sheet1").Select
   
6.     Sheets("Sheet1").Copy Before:=Sheets(1)
   
7.     Sheets("Sheet1 (2)").Select
   
8.     With Sheets("Sheet1 (2)")
   
9.     .Select
   
10.     .[c1] = Sheet2.Range("a" & i)
    
11.     .[f1] = Sheet2.Range("b" & i)
    
12.     .[c2] = Sheet2.Range("c" & i)
    
13.     .[g2] = Sheet2.Range("d" & i)
    
14.     Sheets("Sheet1 (2)").Name = Sheet2.Range("a" & i)
    
15.    End With
    
16.     Next i
    
17. End Sub
    

复制代码

看灰灰灰灰灰机

719404338 发表于 2018-8-23 22:14

谢谢，大神！

abc123281

1. Sub 按照姓名拆分()
   
2. Dim arr
   
3. Application.DisplayAlerts = False
   
4. Application.ScreenUpdating = False
   
5. With Worksheets("数据表")
   
6.    rw = .[a65536].End(xlUp).Row
   
7.    arr = .Range("a2:e" & rw)
   
8.    For i = 1 To UBound(arr)
   
9.       With Worksheets("样表")
   
10.          .[c1] = arr(i, 1)
    
11.          .[f1] = arr(i, 2)
    
12.          .[h1] = arr(i, 4)
    
13.          .[c2] = arr(i, 3)
    
14.          .[g2] = arr(i, 5)
    
15.          .Copy after:=Worksheets(Worksheets.Count)
    
16.           ActiveSheet.Name = arr(i, 1)
    
17.       End With
    
18.    Next
    
19. End With
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. MsgBox "拆分完成！", vbInformation
    
23. End Sub

复制代码

abc123281

根据表1格式表2数据生成多个表abc123.rar (19.8 KB, 下载次数: 41)

2018-8-23 22:52 上传

点击文件名下载附件

看灰灰灰灰灰机

abc123281 发表于 2018-8-23 22:52

谢谢谢谢！！！