VBA实用小程序18：合并文件夹中的所有工作簿

在当前工作簿所在的文件夹中，存在着一些其他的工作簿文件，我们想将这些工作簿中的工作表合并到当前工作簿中，可以使用下面的代码。

复仇者联盟3：无限战争

主演：小罗伯特·唐尼 / 克里斯·海姆斯沃斯 / 马克·鲁法洛

猫眼电影演出 广告

购买

在当前工作簿的代码模块中输入下面的代码：

Sub CombineWorkbooks()

    Dim strPath As String

    Dim strFilename As String

    Dim wkb As Workbook

    Dim wks  As Worksheet

   

    Application.EnableEvents =False

    Application.ScreenUpdating =False

   

    '获取当前工作簿所在路径

    strPath = ActiveWorkbook.Path

    '获取当前工作簿所在文件夹中的Excel文件

    strFilename = Dir(strPath &'\*.xls*', vbNormal)

   

    '遍历文件夹直至找不到文件为止

    Do Until strFilename =''

        '判断是否为当前工作簿

        If strFilename <>ActiveWorkbook.Name Then

            '打开找到的工作簿并复制其工作表到当前工作簿

            Set wkb =Workbooks.Open(Filename:=strPath & '\' & strFilename)

            For Each wks Inwkb.Worksheets

                wks.CopyAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

            Next wks

            '关闭打开的工作簿

            wkb.Close False

        End If

        '获取下一个文件

        strFilename = Dir()

    Loop

   

    Application.EnableEvents = True

    Application.ScreenUpdating =True

End Sub

 

代码中，我们指定变量strPath为当前工作簿所在的文件夹。可以将变量strPath指定的路径修改为想要合并的工作簿所在的文件夹路径，从而合并指定文件夹中的所有工作簿。