要解决的问题是：
现在在某个文件夹下只有一个excel文件，这个文件里有多页工作薄，每个工作薄里的内容要复制到新的excel文件的一个工作薄中，注意是一个工作薄中，而且中间不要少行。下面的这段代码可以实现，但是就有一个问题，从第二页工作薄开始，后面的没个工作薄中的第一行都没有复制到。
可能的原因是没有将选择区域下移一行的原因，但不知道该怎么写。请教大侠解决！！！
Sub HuiZong()
Dim myfile, mypath, wb '声明变量
Application.ScreenUpdating = False '关闭屏幕更新
Sheet1.UsedRange.Offset(1, 0).Clear '清除除表头之外的所有内容
mypath = ThisWorkbook.Path '找到当前工作簿的路径
myfile = Dir(mypath & "\*.xls*") '遍历当前文件夹下的Excel文件
i = 1
j = 0
Do While myfile <> "" '当找到的文件不为空时
If myfile <> ThisWorkbook.Name Then '当找到的文件不是当前Excel工作簿时
Set wb = GetObject(mypath & "\" & myfile) '得到dir找到的工作簿的内容，设为wb
Do While i < wb.Worksheets.Count + 1
With wb.Sheets(i) '对找到的工作簿的sheet1进行操作
.UsedRange.Offset(0, 0).Copy Sheet1.Range("A" & Sheet1.UsedRange.Rows.Count) '复制wb的sheet1从第一行的内容开始
End With
i = i + 1
Loop
wb.Close False '关闭wb工作簿且不保存
End If
myfile = Dir '寻找下一个Excel工作簿
Loop
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
试一下这个代码：第3行的bt = 1是指标题行有1行；如果标题行有多行，请更改1为实际行数。
将要汇总的文件放到一个单独专门的文件夹中。在此文件夹中新建或打开一个Excel文件作为汇总文件，找一个空白Sheet或者新建一个Sheet存放汇总数据。
然后按“Alt+F11”打开VBA编辑窗口，然后在左侧对应的Sheet上双击，右侧空白处粘贴下面的代码。关闭VBA窗口。然后按“Alt+F8”打开宏窗口，选择刚插入的宏，点击“执行”。
Sub hz()
Dim bt, i, r, c, n, first As Long
bt = 1
Dim f, ff As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ff = fso.getfolder(ThisWorkbook.Path & "\")
For Each f In ff.Files
If f.Name <> ThisWorkbook.Name And Left(f.Name, 2) <> "~$" Then
Workbooks.Open ThisWorkbook.Path & "\" & f.Name
With Workbooks(f.Name)
For i = 1 To .Sheets.Count
If first = 0 Then
c = .Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
.Sheets(i).Range("A1").Resize(bt, c).Copy ThisWorkbook.ActiveSheet.Range("A1")
n = bt + 1: first = 1
End If
r = .Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
.Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy ThisWorkbook.ActiveSheet.Range("A" & n)
n = n + r - bt
Next
End With
Workbooks(f.Name).Close False
End If
Next f
Set fso = Nothing
End Sub追问
运行时错误‘1004’：应用程序定义或对象定义错误。
追答按F8单步执行，看一下是执行到哪一行出错，截个图上来看一下。
追问你自己不会测试吗
追答我这边测试通过。
或者你把第22行：Workbooks(f.Name).Close False
改成两句：
Workbooks(f.Name).Saved = True
Workbooks(f.Name).Close
曾经有人出现过这个问题，不知道你是不是这个情况。
按照你说的改成这两句以后，编辑成功，但是复制出来的内容，与我原先自己的代码复制出来的东西一模一样，仍然是有“从第二页开始都没把第一行复制出来”的问题
追答我估计你说的是标题行的问题，也就是每个表复制过来都要带上标题行。代码修改了一下，试一下：
Sub hz()Dim r, c, n As Long
Dim f, ff As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ff = fso.getfolder(ThisWorkbook.Path & "\")
n = 1
For Each f In ff.Files
If f.Name <> ThisWorkbook.Name And Left(f.Name, 2) <> "~$" Then
Workbooks.Open ThisWorkbook.Path & "\" & f.Name
With Workbooks(f.Name).ActiveSheet
c = .Cells(1, Columns.Count).End(xlToLeft).Column
r = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").Resize(r, c).Copy ThisWorkbook.ActiveSheet.Range("A" & n)
n = n + r
End With
Workbooks(f.Name).Saved = True
Workbooks(f.Name).Close
End If
Next f
Set fso = Nothing
End Sub追问
大哥，虽然这修改后的代码，只把最后一页的内容给复制下来了，但我还是感谢你的执着精神，谢谢！
你理解我的这个是标题行的问题，不对，不是标题行的问题，是最后一行没有复制下来的问题
实在没明白“最后一行”是指什么？感觉好像我们的语境没对上……
首先Excel文件其实就是工作簿，工作簿中的每个Sheet叫工作表，工作表中横的为行竖的为列……能否受累截个图上来，举例说明你的问题？
