Excel简单宏定义（Microsoft 版）（快速合并多个表格，合并多个工作表，合并特定工作表）_sub 合并当前工作簿下的所有工作表()on error resume nextapplicatio

---

前言

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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

---

总结

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

---