同一文件夹里的多个EXCEL表格合并到一个EXCEL表格里面

objector2008

各位大侠，我想把同一个文件夹里的多个表格合并到一个表格里面，要求把这些表格“粘到”一起，也就是第二个表格粘到第一个表格最后一行的下一行，第三个表格粘到第二个表格最后一行的下一行，以此类推，请问如何用VBA实现，谢谢了！

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim myPath$, myName$, wb As Workbook
   
3.     Dim funm$, n&
   
4.     Application.ScreenUpdating = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set wb = ThisWorkbook
   
7.     funm = ThisWorkbook.Name
   
8.     Sheet1.Activate
   
9.     Cells.Clear: n = 1
   
10.     myPath = ThisWorkbook.Path & ""
    
11.     myName = Dir(myPath & "*.xls")
    
12.     Do While myName <> "" And myName <> funm
    
13.         With GetObject(myPath & myName)
    
14.             .Sheets(1).Range("A1:t32").Copy Cells(n, 1)
    
15.             .Close False
    
16.         End With
    
17.         n = n + 33
    
18.         myName = Dir
    
19.     Loop
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

蓝桥玄霜

请见附件。

objector2008

非常感谢！但是我的表格的行数和列数不太统一，行数不一定是33行，列数不一定是A-T列，有的页面布局是横向，有的是纵向，我想放在一个表格里打印的时候方便，有没有好办法？

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim myPath$, myName$, wb As Workbook
   
3.     Dim funm$, n&, m&
   
4.     Application.ScreenUpdating = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set wb = ThisWorkbook
   
7.     funm = ThisWorkbook.Name
   
8.     Sheet1.Activate
   
9.     Cells.Clear: n = 1
   
10.     myPath = ThisWorkbook.Path & ""
    
11.     myName = Dir(myPath & "*.xls")
    
12.     Do While myName <> "" And myName <> funm
    
13.         With GetObject(myPath & myName)
    
14.             .Sheets(1).UsedRange.Copy Cells(n, 1)
    
15.             .Close False
    
16.             m = .Sheets(1).UsedRange.Rows.Count + 2
    
17.         End With
    
18.         n = n + m
    
19.         myName = Dir
    
20.     Loop
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

objector2008

谢谢了！！！！

r342327115

蓝桥玄霜 发表于 2012-11-12 15:11

大大， 我复制这个代码到我的文件夹，怎么就不适用了呢？

蓝桥玄霜

r342327115 发表于 2015-7-25 17:29
大大， 我复制这个代码到我的文件夹，怎么就不适用了呢？

建议上传表格附件来说明问题。

M91014037

蓝桥玄霜 发表于 2015-7-26 07:23
建议上传表格附件来说明问题。

大大，我也有个类似的问题，想把每个文件名填充到第一列区域里面

M91014037

附件.rar (630.33 KB, 下载次数: 72)

2015-8-19 14:29 上传

点击文件名下载附件

   大大，能不能帮我解决一下，很急，非常感谢！想在第一列，提取每个文件名填充，其他部分直接合并，不要表头！