来源:https://www.zhihu.com/question/20366713/answer/1514642143
一、需求描述
存在两个Excel工作簿,每个工作簿有多个sheet,需要将两个工作簿中所有sheet合并到一个工作簿。
二、实现
新建Excel工作簿《1.xlsx》,打开该工作簿,按Alt+F11两键,调出Visual Basic 界面,在左侧窗口中,右键选择“插入”—“模块”,将代码粘贴进去,点击运行按钮,完成数据表合并。代码如下
a) 将多个Workbook中的sheets合并到一个Book中:
Sub Workbook_merge() Rem This script is used to collect worksheets of serval workbooks into one workbook! Dim FileOpen Dim X As Integer Dim Wb As Workbook Dim sh As Worksheet Application.ScreenUpdating = False FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbook(*.xlsx),*.xlsx", MultiSelect:=True, Title:="Please select the Workbooks you want to merge:") X = 1 Application.DisplayAlerts = False While X <= UBound(FileOpen) Set Wb = GetObject(FileOpen(X)) For Each sh In Wb.Sheets If Application.WorksheetFunction.CountA(sh.Cells) <> 0 Then sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If Next Wb.Close SaveChanges:=False X = X + 1 Wend Application.DisplayAlerts = False ThisWorkbook.Save Application.ScreenUpdating = True End Sub
b) 合并一个Book中的多个Sheets到当前sheet的代码(自动忽略空白Sheets)
Sub Sheet_merge() Rem This Script can be used to merge all worksheets into current worksheet! Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> ActiveSheet.Name Then X = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count Sheets(j).UsedRange.Copy ActiveSheet.Cells(X, 1) End If Next Application.ScreenUpdating = True MsgBox "All sheets have been merged!", vbInformation, "Attention" End Sub
标签:False,多个,ActiveSheet,Excel,Application,Sheets,sheet From: https://www.cnblogs.com/cmxu/p/17315055.html