多工作簿指定工作表合并

z775711365

现在我有30个工作簿，每个工作簿名称不一样，每个工作簿有3个工作表，[派送明细]、[派送汇总]和[专车明细]，同名工作表的格式是一样的，我现在想把这30个工作簿指定的工作表进行合并，比如新建一个工作簿对30个工作簿的[专车明细]进行合并。

zhaogang1960

如果不合题意，请上传附件说明：

1. Sub Macro1()
   
2.     Dim MyPath$, MyName$, sh As Worksheet, m&
   
3.     Application.ScreenUpdating = False
   
4.     MyPath = ThisWorkbook.Path & ""
   
5.     MyName = Dir(MyPath & "*.xls")
   
6.     Do While MyName <> ""
   
7.         If MyName <> ThisWorkbook.Name Then
   
8.             m = m + 1
   
9.             With GetObject(MyPath & MyName)
   
10.                 If m = 1 Then
    
11.                     .Sheets("专车明细").Copy
    
12.                     Set sh = ActiveSheet
    
13.                 Else
    
14.                     .Sheets("专车明细").UsedRange.Copy sh.[a65536].End(xlUp).Offset(1)
    
15.                 End If
    
16.                 .Close False
    
17.             End With
    
18.         End If
    
19.         MyName = Dir
    
20.     Loop
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

z775711365

zhaogang1960 发表于 2014-6-22 21:50
如果不合题意，请上传附件说明：

不知道为什么，如果要合并的工作簿都是.xlsx格式的，我把65536改成1048576就可以运行，如果工作簿格式是.xlsm格式的 就会提示下标越界，还有一点要求就是每个表格都有抬头，合并的时候可以不要合并第一行或者前两行之类的嘛

zhaogang1960

z775711365 发表于 2014-6-23 17:35
不知道为什么，如果要合并的工作簿都是.xlsx格式的，我把65536改成1048576就可以运行，如果工作簿格式是. ...

请上传附件，模拟效果

z775711365

zhaogang1960 发表于 2014-6-23 17:43
请上传附件，模拟效果

非常感谢，现在我弄好了，我自己在Else里面加了一行aRow = .Sheets("专车明细").Range("a1048576").End(xlUp).Row 求行数，然后把你写的那个UsedRange改了下就好了，多谢了哈！

LMY123

同薄单表合并成一薄一表