1、合并多个Excel表格的多个sheet到一个工作簿

来源: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

 

posted @ 2023-04-13 15:38  _幸会  阅读(1319)  评论(0编辑  收藏  举报