【VBA案例012】合并工作簿

程技 VBA

发布时间 : 2023-10-23 00:00

字数:361 阅读 :

方法一：复制粘贴
方法二：数组

大家好！这次分享的是非常经典的案例：合并工作簿。

相信大家已经很熟悉这个问题了，就是把多个工作簿里的工作表合并到同一个sheet里。

这次同样分享两个方法，以下是VBA代码。详细解析请看文末的视频。

自定义函数：

Private Function filelist(folderspec, Optional pstr = "*.txt")
    On Error GoTo errline
    Dim fs, f, f1, fc, i, farr
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    ReDim farr(1 To fc.Count)
    For Each f1 In fc
        If f1.Name Like pstr And Not f1.Name Like "*~$*" Then
            i = i + 1
            farr(i) = f1.Name
        End If
    Next
    ReDim Preserve farr(1 To i)
    filelist = farr
errline:
End Function

方法一：复制粘贴

Sub 复制粘贴()

    Dim i, j, k
    Dim fileAr

    fileAr = filelist(ThisWorkbook.Path & "\文件夹\", "*.xlsx")

    Application.ScreenUpdating = False
    For i = 1 To UBound(fileAr)
        With Workbooks.Open(ThisWorkbook.Path & "\文件夹\" & fileAr(i))
            With .Sheets(1)
                .Range("a2:e" & .[a65536].End(3).Row).Copy Sheet1.Range("a" & Sheet1.[a65536].End(3).Row + 1)
            End With
            .Close False
        End With
    Next i
    Application.ScreenUpdating = True

End Sub

方法二：数组

Sub 数组()

    Dim i, j, k
    Dim fileAr

    fileAr = filelist(ThisWorkbook.Path & "\文件夹\", "*.xlsx")

    Dim tmp
    Application.ScreenUpdating = False
    For i = 1 To UBound(fileAr)
        With Workbooks.Open(ThisWorkbook.Path & "\文件夹\" & fileAr(i))
            With .Sheets(1)
                tmp = .Range("a2:e" & .[a65536].End(3).Row)
                Sheet1.Range("a" & Sheet1.[a65536].End(3).Row + 1).Resize(UBound(tmp), UBound(tmp, 2)) = tmp
            End With
            .Close False
        End With
    Next i
    Application.ScreenUpdating = True

End Sub

原始链接

转载请注明来源，欢迎对文章中的引用来源进行考证，欢迎指出任何有错误或不够清晰的表达。可以在下面评论区评论，也可以邮件至 richffan@outlook.com