[已解决]怎么可以合并每个工作簿的第一个工作表到一个工作簿里

幸福的忧伤250

怎么可以合并每个工作簿的第一个工作表到一个工作簿里

最佳答案

月排行榜 / 总排行榜

jlf2003

2012-10-28 17:38

1. Sub Macro1()
   
2.      Dim MyPath$, MyName$, lc&, m&, sh As Worksheet
   
3.      Set sh = ActiveSheet
   
4.      MyPath = ThisWorkbook.Path & ""
   
5.      MyName = Dir(MyPath & "*.xls")
   
6.      Application.ScreenUpdating = False
   
7.      sh.UsedRange.Clear
   
8.      Do While MyName <> ""
   
9.          If MyName <> ThisWorkbook.Name Then
   
10.              m = m + 1
    
11.              With GetObject(MyPath & MyName)
    
12.                  With .Sheets(1)
    
13.                      If m = 1 Then lc = 1 Else lc = .[a1].CurrentRegion.Columns.Count + 1
    
14.                      .[a1].CurrentRegion.Copy sh.Cells(1, lc)
    
15.                  End With
    
16.                  .Close False
    
17.              End With
    
18.          End If
    
19.          MyName = Dir
    
20.      Loop
    
21.      Application.ScreenUpdating = True
    
22.      MsgBox "完毕"
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

直接用V吧。

hongqiqqq

是第一个表1中的所有单元各都到一个里面？还是要分开相应单元格

zjdh

没有附件，谁知道是啥要求？？！！

jlf2003

1. Sub Macro1()
   
2.      Dim MyPath$, MyName$, lc&, m&, sh As Worksheet
   
3.      Set sh = ActiveSheet
   
4.      MyPath = ThisWorkbook.Path & ""
   
5.      MyName = Dir(MyPath & "*.xls")
   
6.      Application.ScreenUpdating = False
   
7.      sh.UsedRange.Clear
   
8.      Do While MyName <> ""
   
9.          If MyName <> ThisWorkbook.Name Then
   
10.              m = m + 1
    
11.              With GetObject(MyPath & MyName)
    
12.                  With .Sheets(1)
    
13.                      If m = 1 Then lc = 1 Else lc = .[a1].CurrentRegion.Columns.Count + 1
    
14.                      .[a1].CurrentRegion.Copy sh.Cells(1, lc)
    
15.                  End With
    
16.                  .Close False
    
17.              End With
    
18.          End If
    
19.          MyName = Dir
    
20.      Loop
    
21.      Application.ScreenUpdating = True
    
22.      MsgBox "完毕"
    
23. End Sub
    

复制代码

不信这样还重名

多表合并不知道车车老师的那个邮件插件里的功能可不可以实现呢？当然，自己用VB肯定也是可以的，能用现成的就省点心吧{:061:}