合并表头有合并单元格的多工作簿的表内容

qlmgu

各位老师，一个难题请求帮助：希望合并多个表的表题有多行，且名称里有合并单元格多个工作簿。见附件。
检索了很多合并工作簿、工作表的帖子，但是比较多程序要求表题比较规范。我这些工作簿表头应该属于不规范的格式。我应该再检索下，但是由于试验了多个程序都需要规范的表格，加上期末工作急需，能否敬请老师出手相助，或给我指示具体的参考帖子。
很有可能，以后要合并的表头格式有变化，但是各个工作簿的格式是一样的。在此感谢各位了。


多个需要合并的工作簿的sheet1的表头格式和内容一样：


希望按表头的格式合并各工作簿sheet1的内容，表头只需要一个就行了。

合并工作簿求助.rar (22.98 KB, 下载次数: 10)

2023-7-12 12:48 上传

点击文件名下载附件

shiruiqiang

从第四行开始合并

cyq4896

请试一试......

qlmgu

shiruiqiang 发表于 2023-7-12 13:23
从第四行开始合并

是的老师，谢谢您解读

qlmgu

cyq4896 发表于 2023-7-12 14:01
请试一试......

感谢老师出手相助，您的程序不但可适用原来表头，还可以加行列，通用性很好，太感谢您了。

cyq4896

qlmgu 发表于 2023-7-12 14:10
感谢老师出手相助，您的程序不但可适用原来表头，还可以加行列，通用性很好，太感谢您了。

太客气了，互相学习。

yynrzwh

1. Sub 按钮1_Click()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. ph = ThisWorkbook.Path & ""
   
5. nm = ThisWorkbook.Name
   
6. f = Dir(ph & "*.xls*")
   
7.     Do While f <> ""
   
8.         If f <> nm And Left(f, 2) <> "~$" Then
   
9.             lr = Cells(Rows.Count, 5).End(3).Row + 1
   
10.             With Workbooks.Open(ph & f)
    
11.                 With .Sheets(1)
    
12.                     lr2 = .Cells(Rows.Count, 1).End(3).Row
    
13.                     .Range("A4:K" & lr2).Copy
    
14.                 End With
    
15.                 .Close False
    
16.             End With
    
17.             Range("A" & lr).PasteSpecial Paste:=xlPasteAll
    
18.         End If
    
19.     f = Dir
    
20.     Loop
    
21. Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

qlmgu

yynrzwh 发表于 2023-7-12 15:10

感谢老师出手相助。我拷贝了您的程序，但是未见反应？是否我操作不当？

yynrzwh

用这个附件试试

ykcbf1100

数据表表头都一样的，常规合并就可以了。