拆分同一名称的所有表

23366320

我需要将表1-表9中的数据都按照县市的名称拆分，例如：拆分的如果是恩施的表，那么表1-表9的县市都是恩施的，没有其它县市 的数据！谢谢！

liu985

数据筛选，复制到新表

23366320

可是我有很多的小表，而且表里的内容都很多，我是想请问有没有写个编程，可以一下子把所有表都拆分开来，而且我每天都要做重复的事情，首先是做好里面所有的表，然后要将每个县市的数据拆分成一个表，然后分发给各县市

ykcbf1100

这个更适合用VBA吧，借题练习一下。

ykcbf1100

1. Sub ykcbf()   '//2025.3.25 多表拆分为多工作簿多表
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Dim tm: tm = Timer
   
6.     Set ws = ThisWorkbook
   
7.     p = ThisWorkbook.Path & ""
   
8.     On Error Resume Next
   
9.     col = 1: bt = 1
   
10.     For Each sht In ws.Sheets
    
11.         arr = sht.UsedRange
    
12.         For i = bt + 1 To UBound(arr)
    
13.             If arr(i, col) <> Empty Then d(arr(i, col)) = ""
    
14.         Next
    
15.     Next
    
16.     For Each k In d.keys
    
17.         ws.Sheets.Copy
    
18.         Set wb = ActiveWorkbook
    
19.         For Each sht In wb.Sheets
    
20.             With sht
    
21.                 If .FilterMode = True Then .ShowAllData
    
22.                 arr = .UsedRange
    
23.                 .DrawingObjects.Delete
    
24.                 .Rows(bt).AutoFilter Field:=col, Criteria1:="<>" & k
    
25.                 .UsedRange.Offset(bt).Delete
    
26.                 If .FilterMode = True Then .ShowAllData
    
27.             End With
    
28.         Next
    
29.         wb.SaveAs p & k
    
30.         wb.Close
    
31.     Next
    
32.     Application.ScreenUpdating = True
    
33.     Application.DisplayAlerts = True
    
34.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
35. End Sub
    
36. 
    
37. 
    

复制代码