一、单文件多工作表合并
情况一:单文件多工作表合并,即在一张工作薄中,有多个工作表格,每个表格的内容都一致,只是所属的类别不同。现在要将所有类别表格里的内容全部合并到一张工作表格里。如以下表格(诺基亚零配件清单),一共有200多种型号,每种型号一个清单,现在要将它们全部合并到一张工作表格里。
二、情况一解决方案
解决方案:插入一张工作表格,命名为“汇总”。按Alt+F11,进入VBA编辑器,写上如下代码:
Option Explicit
' 后面要用的,开始粘贴的行号 Private beginRowNo As Long
' 此过程启动汇总 Private Sub CommandButton1_Click() Dim sheetCount As Integer sheetCount = ThisWorkbook.Worksheets.Count
Dim i As Integer
beginRowNo = 1
' 以下循环遍历每个表格,将需要汇总的表格里的内容一一粘贴到“汇总”表格里
For i = 1 To sheetCount
Dim sheetName As String
sheetName = ThisWorkbook.Worksheets(i).Name
Select Case LCase(sheetName)
Case "summary":
MsgBox "跳过 " + sheetName
Case "update record":
MsgBox "跳过 " + sheetName
Case "汇总":
MsgBox "跳过 " + sheetName
Case Else:
DoSubtotal (sheetName)
End Select
Next i
End Sub
' 此过程用来将指定表格名称的表格内容,复制粘贴到“汇总”表格里。 Private Sub DoSubtotal(ByVal sheetName As String) Dim sourceSheet As Worksheet Dim destSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets(sheetName)
Set destSheet = ThisWorkbook.Worksheets("汇总")
sourceSheet.UsedRange.Copy 'destSheet.Range("A" & beginrowno)
destSheet.Range("A" & beginRowNo).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True
beginRowNo = beginRowNo + sourceSheet.UsedRange.Rows.Count
Set sourceSheet = Nothing
Set destSheet = Nothing
End Sub
然后,将光标放置在 CommandButton1_Click 过程中的任意位置,按F5运行即可。
三、多文件合并
情况二:多文件合并,即在一个文件夹里,有多个工作薄文件,它们的第一个表格里的内容形式都一样,现在要将它们全部合并到一个工作薄里。如一个文件夹内,有每天的订单Excel文件,现在要将全部订单数据合并到一个Excel文件内。
四、多文件合并解决方案
解决方案:新建一个Excel工作薄,按Alt+F11,进入VBA编辑器,输入如下代码:
Sub 合并工作簿() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If x = 1 Dim currentWorkSheet As Worksheet Dim rng As Range Set currentWorkSheet = ActiveWorkbook.ActiveSheet Set rng = currentWorkSheet.Range("A1") Dim wkb As Workbook Dim wks As Worksheet ' 以下循环分别将每个工作薄中的第一个工作表里的内容,复制粘贴到当前工作薄的第一张工作表里。 While x <= UBound(FilesToOpen) Set wkb = Workbooks.Open(Filename:=FilesToOpen(x)) Set wks = wkb.Worksheets(1) rng.Offset(0, 10).Value = wkb.Name wks.UsedRange.Copy rng Set rng = rng.Offset(wks.UsedRange.Rows.Count, 0) wkb.Close False x = x + 1 Wend Set wks = Nothing Set rng = Nothing Set wkb = Nothing Set currentWorkSheet = Nothing ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub
将光标放在过程“合并工作薄”的任意位置,按F5运行,在弹出的打开文件框中,选择需要合并的全部文件,确定即可。
五、多文件合并之二
情况三:多文件合并。类似情况二,但是,只将多个工作薄里的工作表复制到同一个工作薄里,不需要到同一个工作表。
六、多文件合并之二的解决方案
解决方案:类似情况二,代码只有一点点区别:
Sub 合并工作簿2() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If x = 1 ' 主要就是这里,这个循环处理代码与情况二稍有不同! While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub
注:如果先做情况三,再做情况一,那么就等于情况二。
[donate: www.zizhujy.com]