VBA-合并多个工作簿

1.首先我们理清思路,我们将所有要合并到一起的Excel工作簿放到一个文件夹里,该文件夹里面有一个启用宏的工作表,启动该工作表的宏,就可以将该文件夹里面的所有Excel文件的内容合并到一张表里面,后面可以将合并完成后的数据复制或剪切到新的Excel表中。

2.代码如下

Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn

Dim Wb As Workbook

Dim i, a, b, d, c, e

Application.ScreenUpdating = False

MP = ActiveWorkbook.Path '获取当前工作薄的路径

MN = Dir(MP & "\" & "*.xls") '遍历Excel文件

AW = ActiveWorkbook.Name '获取当前工作簿名称

Num = 0

e = 1

Do While MN <> ""

If MN <> AW Then

Set Wb = Workbooks.Open(MP & "\" & MN)

a = a + 1

With Workbooks(1).ActiveSheet

For i = 1 To Sheets.Count
'复制工作表内容

If Sheets(i).Range("a1") <> "" Then

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)

d = Wb.Sheets(i).UsedRange.Columns.Count

c = Wb.Sheets(i).UsedRange.Rows.Count - 1
'增加一列
wn = Wb.Sheets(i).Name

.Cells(1, d + 1) = "表名"

.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn

e = e + c

Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)

End If

Next

Wbn = Wbn & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MN = Dir

Loop

Range("a1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"

End Sub

3.在Excel工作表中整加一个按钮控件,指定宏,点击运行效果如下:

  • 16
    点赞
  • 73
    收藏
    觉得还不错? 一键收藏
  • 5
    评论
您可以使用 VBA 宏来合并多个 Excel 工作簿。以下是一个简单的示例代码: ```VBA Sub MergeWorkbooks() Dim Path As String, Filename As String, Sheet As Worksheet Dim LastRow As Long, LastColumn As Long, StartRow As Long, StartColumn As Long Dim DestSheet As Worksheet, DestWorkbook As Workbook '设置目标工作簿工作表 Set DestWorkbook = ThisWorkbook Set DestSheet = DestWorkbook.Worksheets("Sheet1") '设置源工作簿的路径 Path = "C:\MyFolder\" '循环遍历所有源工作簿 Filename = Dir(Path & "*.xlsx") Do While Filename <> "" '打开源工作簿并复制数据 Workbooks.Open Filename:=Path & Filename, ReadOnly:=True Set Sheet = ActiveWorkbook.Worksheets(1) LastRow = Sheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row LastColumn = Sheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column StartRow = DestSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 StartColumn = DestSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1 Sheet.Range(Sheet.Cells(1, 1), Sheet.Cells(LastRow, LastColumn)).Copy DestSheet.Cells(StartRow, StartColumn) '关闭源工作簿 Workbooks(Filename).Close '获取下一个源工作簿的文件名 Filename = Dir() Loop End Sub ``` 在上面的代码中,您需要设置以下内容: - `Path` 变量:指定源工作簿所在的文件夹路径。 - `DestWorkbook` 变量:指定目标工作簿。 - `DestSheet` 变量:指定目标工作表。 - `Sheet` 对象:表示当前打开的源工作簿中的第一个工作表。如果您需要合并其他工作表,请使用不同的变量和循环来遍历它们。 请注意,上述代码仅适用于在同一个 Excel 实例中打开的工作簿。如果您需要处理不同的 Excel 实例中的工作簿,您需要使用更复杂的代码来实现。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 5
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值