Sub 合并汇总()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen_N = Application.GetOpenFilename("xls文件,*.xls", _
Title:="请选择要合并工作簿:", MultiSelect:=True)
Newbz = 0
On Error Resume Next
For Each FileToOpen In FileToOpen_N
If FileToOpen <> False Then
If Newbz = 0 Then
Booknum = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = Booknum
NewBookName = ActiveWorkbook.Name
Sheets(1).Name = "sheet_tmp"
Newbz = 1
End If
Set OpenBook = Workbooks.Open(FileToOpen)
For Each Xlsheet In OpenBook.Sheets
Xlsheet.Copy Before:=Workbooks(NewBookName).Sheets("sheet_tmp")
Next
OpenBook.Close SaveChanges:=False
End If
Next
Workbooks(NewBookName).Sheets("sheet_tmp").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim sht As Worksheet, lstRowZb As Integer, lstRow As Integer
'lstRowZb:总表的lastrow
Worksheets("1").Select
Worksheets("1").Range("a1:h1").Copy Destination:=Range("a1")
'复制表头
For Each sht In Worksheets
lstRowZb = Range("a65536").End(xlUp).Row '每次COPY前取得总表的最后一行
With sht
If .Name <> "1" Then
lstRow = .Range("a65536").End(xlUp).Row
.Range("a2:h" & lstRow).Copy Destination:=Cells(lstRowZb + 1, "a")
End If
End With
Next sht
End Sub