Question

怎么将多个Excel工作簿合并成一个工作簿（2007excel）

启用宏，以下代码输入后如图，不能完成合并，求解

Sub CombineFiles()
Dimpath As String DimFileName As String DimLastCell As Range DimWkb As Workbook DimWS As Worksheet DimThisWB As String Dim MyDir AsString MyDir =ThisWorkbook.path & "\" 'ChDriveLeft(MyDir, 1) 'find all the excel files 'ChDir MyDir 'Match =Dir$("") ThisWB =ThisWorkbook.Name Application.EnableEvents = False Application.ScreenUpdating = False path =MyDir FileName =Dir(path & "\*.xls", vbNormal) Do UntilFileName = "" If FileName <> ThisWB Then Set Wkb = Workbooks.Open(FileName:=path & "\"& FileName) For Each WS In Wkb.Worksheets Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) If LastCell.Value = "" And LastCell.Address = Range("$A$1").AddressThen Else WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If Next WS Wkb.Close False End If FileName = Dir() Loop Application.EnableEvents = True Application.ScreenUpdating = True Set Wkb =Nothing Set LastCell= NothingEnd Sub

Answer 1

代码 好多地方 连到一起 ， 要加空格， 我帮你改好了， 已测试可用

Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String

Dim MyDir As String
MyDir = ThisWorkbook.path & "\"
'ChDriveLeft(MyDir, 1) 'find all the excel files
'ChDir MyDir
'Match =Dir$("")

ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = MyDir
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
Set LastCell = Nothing
End Sub

追问

粘贴过去都是横版的代码，无法按照你的调整直接完成，帮忙看看我的excel设置是不是有什么问题，麻烦了，感谢~

追答

我把 代码放 文件里面， 你下载用吧