利用VBA将多个工作簿的数据合并

经过两个步骤

第一步，将多个工作簿合并为一个工作簿

第二部，将一个工作簿的多个工作表进行合并

 

1）将多个工作簿合并为一个工作簿

Sub CombineWorkbooks()
Dim strFileName As String
Dim wb As Workbook
Dim ws As Object

'包含工作簿的文件夹,根据实际修改
Const strFileDir As String = "F:\智慧安徽\新建文件夹\"

Application.ScreenUpdating = False

Set wb = Workbooks.Add(xlWorksheet)
strFileName = Dir(strFileDir & "*.xls*")

Do While strFileName <> vbNullString
Dim wbOrig As Workbook
Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)

For Each ws In wbOrig.Sheets
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
If wbOrig.Sheets.Count > 1 Then
wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index
Else
wb.Sheets(wb.Sheets.Count).Name = strFileName
End If
Next

wbOrig.Close SaveChanges:=False

strFileName = Dir

Loop

Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wb = Nothing

End Sub

 

2）将同一工作簿的多个工作表合并

Sub 合并工作表()
Dim Tto%
Dim m As Integer
Dim n As Long
Dim o As Long
Tto = Worksheets.Count
For m = 2 To Tto
n = Sheets(m).[a1048576].End(xlUp).Row   ’返回实际使用的行数，excel 2007最大行为1048576，
o = Sheets(1).[a1048576].End(xlUp).Row 
Sheets(m).Select
Range("a1", "b" & n).Select
Range("a" & n).Activate
Selection.Copy
Sheets(1).Select
Range("a" & o + 1).Select
ActiveSheet.Paste
Next

'删除其他工作表
Application.DisplayAlerts = False '删除时不用确认
For m = Worksheets.Count To 2 Step -1
Sheets(m).Delete
Next

End Sub