多张Excel表，表头一样但是数据不想同，如果合并到一张表中

雨中木屋

FL-FQ 发表于 2013-8-18 10:59
我发的是以前在网上找的看能不能帮上你。将要合并的文件与“合并多个表.xlsm”放在一个文件夹内。然 ...

我依你的办法并在每个工作表中，和你一样的相应位置加了字符0，在“合并多个表.xlsm"中
      提示：无效的宏名     （试图将宏名称修改为何你所附件一样的名称，同样显示：无效的宏名）
               为何是这样呢？不能合并？我错在哪了？    如果可以的话希望看下.gif的相关操作！！！谢谢   

FL-FQ

改进了一下，不用在每个文件里面加结尾字符0了。

ykcbf1100

借题练习，多文件合并，VBA

代码自动判断工作表中有效数据行数，原格式合并

ykcbf1100

1. Sub ykcbf()   '//2025.4.14  多文件汇总
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set sh = Sheets("汇总")
   
6.     sh.UsedRange.Clear
   
7.     p = ThisWorkbook.Path & ""
   
8.     On Error Resume Next
   
9.     Dim tm: tm = Timer
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If LCase$(f.Name) Like "*.xls*" Then
    
12.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
13.                 Set wb = Workbooks.Open(f, 0)
    
14.                 m = m + 1
    
15.                 If m = 1 Then
    
16.                     wb.Sheets(1).UsedRange.Copy sh.[a1]
    
17.                 Else
    
18.                     r = sh.UsedRange.Find("*", , -4163, , 1, 2).Row + 1
    
19.                     wb.Sheets(1).UsedRange.Offset(1).Copy sh.Cells(r, 1)
    
20.                 End If
    
21.                 wb.Close 0
    
22.             End If
    
23.         End If
    
24.     Next f
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
27. End Sub
    

复制代码