求助表头只复制一次，表尾最后5行不复制，希望同时支持合并*.xls

7837323

Sub 合并当前目录下所有工作簿()
Dim wb, ws, title_row, end_row, copy_title, file_path, file_name, save_file, fso As Object
'--------------------参数填写：title_row，数字，第1行为1向下递增；end_row，数字；file_path，合并文件夹
title_row = 1  '表头行数，仅复制1次；如果为0，则表示没有表头或表头每次都复制
end_row = 0    '表尾行数，不参与合并
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xlsx")
AWbName = ActiveWorkbook.Name
Do While MyName <> ""
If MyName <> AWbName Then
Set wb = Workbooks.Open(MyPath & "\" & MyName)
c = ThisWorkbook.Sheets("sheet1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
If c = 1 Then   '防止合并的工作簿第一行空着
c = 0
End If
ActiveSheet.UsedRange.Copy ThisWorkbook.Sheets("sheet1").Cells(c + 1, 1)  '合并工作簿的第一个sheet名字为：sheet1
wb.Close False
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "已完成"
End Sub

7837323

同时跳过空白行

7837323

大神都休息了吗

沈默00

个人觉得你应该上附件，把需求的结果做好，这样更便于解决

ykcbf1100

没有附件不好说。
问题不难，关键是你要上传附件。

于箱长

好多字儿

7837323

ykcbf1100 发表于 2023-6-30 14:00
没有附件不好说。
问题不难，关键是你要上传附件。

老师附件已上传，有空帮帮弄一下

shiruiqiang

7837323 发表于 2023-6-30 16:27
老师附件已上传，有空帮帮弄一下

新手路过。练个手吧。

shiruiqiang

看你发帖和内容附件要求不一样。都复制的话，代码写法不一样:range("a1:l"& iend).copy

7837323

shiruiqiang 发表于 2023-6-30 21:15
看你发帖和内容附件要求不一样。都复制的话，代码写法不一样:range("a1:l"& iend).copy

老师，如果合并的工作表中没有“单位负责人”字符，代码运行就会出错，有办法完善吗