多薄内多表合并生成不重复多个表

鄂龙蒙

请教：将本文件夹下多个（个数不确定）工作薄内多个（个数不确定）工作表，按不重复的表名，在《汇总合并表》工作薄内新建（生成）【同名表】并合并其内容。谢谢啦！

多薄内多表合并问题.rar (28.94 KB, 下载次数: 25)

2017-5-27 14:51 上传

点击文件名下载附件

蓝桥玄霜

先获取文件夹中所有的文件名，赋给一数组，循环数组，获取每一个工作表的名字，组成字典，生成新表，复制数据。
建议搜索多工作簿提取数据的帖子，有很多。

chengshanming

1. 参看邮件！

复制代码

microyip

1. Sub 汇总()
   
2.     Dim vData As Variant, nRow As Double, nCol As Integer
   
3.     Dim vFill As Variant, nFill As Double
   
4.     Dim dicSheet As Object
   
5.     Dim sFile As String, wWB As Workbook, wSH As Worksheet
   
6.    
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Set dicSheet = CreateObject("Scripting.Dictionary")
   
10.     sFile = "开始查找"
    
11.     Do While sFile <> ""
    
12.         If sFile = "开始查找" Then
    
13.             sFile = Dir(ThisWorkbook.Path & "\*.xls*")
    
14.         Else
    
15.             If sFile <> ThisWorkbook.Name Then
    
16.                 With Workbooks.Open(ThisWorkbook.Path & "" & sFile)
    
17.                     For Each wSH In .Sheets
    
18.                         If dicSheet.Exists(wSH.Name) Then
    
19.                             vFill = dicSheet(wSH.Name)
    
20.                             nFill = UBound(vFill, 2)
    
21.                         Else
    
22.                             vFill = Empty
    
23.                             ReDim vFill(1 To 2, 1 To 1)
    
24.                             nFill = 1
    
25.                             vFill(1, 1) = "单位名称"
    
26.                             vFill(2, 1) = "姓名"
    
27.                         End If
    
28.                         vData = wSH.[A1].CurrentRegion.Value
    
29.                         For nRow = 2 To UBound(vData)
    
30.                             nFill = nFill + 1
    
31.                             ReDim Preserve vFill(1 To 2, 1 To nFill)
    
32.                             For nCol = 1 To 2
    
33.                                 vFill(nCol, nFill) = vData(nRow, nCol)
    
34.                             Next
    
35.                         Next
    
36.                         dicSheet(wSH.Name) = vFill
    
37.                     Next
    
38.                     .Close False
    
39.                 End With
    
40.             End If
    
41.             sFile = Dir
    
42.         End If
    
43.     Loop
    
44.     ThisWorkbook.Activate
    
45.     For Each wSH In Sheets
    
46.         If wSH.Name <> "合并操作表" Then wSH.Delete
    
47.     Next
    
48.     If dicSheet.Count > 0 Then
    
49.         vData = Empty
    
50.         For Each vData In dicSheet.Keys
    
51.             Sheets.Add after:=Sheets(Sheets.Count)
    
52.             With ActiveSheet
    
53.                 .Name = vData
    
54.                 vFill = dicSheet(.Name)
    
55.                 .[A1:B1].Resize(UBound(vFill, 2)) = Application.WorksheetFunction.Transpose(vFill)
    
56.             End With
    
57.         Next
    
58.     End If
    
59.     Application.DisplayAlerts = True
    
60.     Application.ScreenUpdating = True
    
61. End Sub

复制代码

microyip

附上附件以供参考

laoau128

原来你也有需要别人的时候