文章目录

• 前言
• 具体操作
• 总结

  ---

  前言

  Excel简单宏定义（Microsoft 版）（快速合并多个表格，合并多个工作表，合并特定工作表）

  ---

  具体操作

  1. 合并当前工作簿下的所有工作表

  当前表格中有两个工作表为Sheet1和Sheet2，目的: 将两个表合并为一个表Sheet1

  输入代码并运行

  Sub 合并当前工作簿下的所有工作表()
  On Error Resume Next
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set st = Worksheets.Add(before:=Sheets(1))
  st.Name = "合并"
  For Each shet In Sheets:
  If shet.Name <> "合并" Then
  i = st.Range("A" & Rows.Count).End(xlUp).Row + 1
  shet.UsedRange.Copy
  st.Cells(i, 1).PasteSpecial Paste:=xlPasteAll
  End If
  Next
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  MsgBox "已完成"
  End Sub
  

  2. 合并当前目录下工作簿中特定工作表

  当前目录下中有三个表格为工作表1 、工作表2、工作表3，目的: 将三个表格中的第二个工作表合并为一个表格-工作表1

  三个表格是一样的，这里就不在每个都展示图片了

  Sub 合并当前目录下工作簿中特定工作表()
  Application.ScreenUpdating = False
  Dim wb, wb1 As Excel.Workbook
  Dim sh As Excel.Worksheet
  s = Split(ThisWorkbook.Name, ".")(1)
  f = Dir(ThisWorkbook.Path & "\*" & s) '生成查找EXCEL的目录
  Do While f <> "" '在目录中循环
      If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿
          Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
          wb.Worksheets("sheet2").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) '查找每个工作簿中的第二个工作表
          ActiveSheet.Name = Split(wb.Name, ".")(0)
          wb.Close
      End If
      f = Dir
  Loop
  Application.ScreenUpdating = True
  MsgBox "已完成"
  End Sub
  

  3. 合并当前目录下所有工作簿的全部工作表

  当前目录有两个表格：工作表1（sheet1）、工作表2（sheet1），目的: 将当前目录下，两个表格里面的所有工作表合并为一个工作表sheet1

  Sub 合并当前目录下所有工作簿的全部工作表()
  Dim MyPath, MyName, AWbName
  Dim Wb As Workbook, WbN As String
  Dim G As Long
  Dim Num As Long
  Dim BOX As String
  Application.ScreenUpdating = False
  MyPath = ActiveWorkbook.Path
  MyName = Dir(MyPath & "\" & "*.xlsx") 'xlsx文件类型
  AWbName = ActiveWorkbook.Name
  Num = 0
  Do While MyName <> ""
  If MyName <> AWbName Then
  Set Wb = Workbooks.Open(MyPath & "\" & MyName)
  Num = Num + 1
  With Workbooks(1).ActiveSheet
  .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
  For G = 1 To Sheets.Count
  Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
  Next
  WbN = WbN & Chr(13) & Wb.Name
  Wb.Close False
  End With
  End If
  MyName = Dir
  Loop
  Range("B1").Select
  Application.ScreenUpdating = True
  MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
  End Sub
  

  ---

  总结

  Excel简单宏定义（Microsoft 版）（快速合并多个表格，合并多个工作表，合并特定工作表）

  ---