[已解决]数据拆分

diao0109

我的表格里有400多条记录，我想把这400多条记录拆分成400张一样的表格（带有标题行和一行数据），数据筛选我不太会用了，在线求解！谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2016-7-29 10:09

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Set sht = Sheets("数据源")
   
4. arr = sht.Range("a1").CurrentRegion
   
5. n = UBound(arr, 2)
   
6. Application.DisplayAlerts = False
   
7. For Each sh In Sheets
   
8.     If sh.Name <> "数据源" Then sh.Delete
   
9. Next
   
10. Application.DisplayAlerts = True
    
11. For i = 2 To UBound(arr)
    
12.     If Not Sheets(arr(i, 1)) Is Nothing Then
    
13.         With Sheets.Add(after:=Sheets(Sheets.Count))
    
14.             sht.[a1].Resize(1, n).Copy .[a1]
    
15.             sht.Cells(i, 1).Resize(1, n).Copy .[a2]
    
16.             .Name = arr(i, 1)
    
17.         End With
    
18.     End If
    
19. Next
    
20. sht.Activate
    
21. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Set sht = Sheets("数据源")
   
4. arr = sht.Range("a1").CurrentRegion
   
5. n = UBound(arr, 2)
   
6. Application.DisplayAlerts = False
   
7. For Each sh In Sheets
   
8.     If sh.Name <> "数据源" Then sh.Delete
   
9. Next
   
10. Application.DisplayAlerts = True
    
11. For i = 2 To UBound(arr)
    
12.     If Not Sheets(arr(i, 1)) Is Nothing Then
    
13.         With Sheets.Add(after:=Sheets(Sheets.Count))
    
14.             sht.[a1].Resize(1, n).Copy .[a1]
    
15.             sht.Cells(i, 1).Resize(1, n).Copy .[a2]
    
16.             .Name = arr(i, 1)
    
17.         End With
    
18.     End If
    
19. Next
    
20. sht.Activate
    
21. End Sub

复制代码