【Excel VBA 编程】自动化实现多个Excel表格数据合并输出到一个Excel文档中

文章目录

引言

问题的分析与设计

VBA打开关闭Excel文件

读取Excel文件内容

Excel文档之间复制粘贴数据

代码入口设计

代码实现

运行结果

回顾总结

引言

工作中为了方便查看和数据分析，我们经常会将很多Excel中的表格合并到一起，手动操作特别的麻烦，这个时候VBA就派上用场了，它可以帮助我们自动合并Excel内容

提前准备测试数据，有若干个待合并的Excel表格，存放路径：C:Test测试路径

每个Excel文档中内容不同，显示如下：

现在需要将它们合并后输出到C:Test汇总结果.xlsx文档中，来看一下要怎么实现吧

问题的分析与设计

整个功能实现设计到几个知识点，首先是利用VBA打开、关闭指定的Excel文件，其次是读取指定Excel数据，最后才是复制粘贴，内容有点多我们逐个介绍

VBA打开关闭Excel文件

使用Workbooks.Open方法即可，参考如下

Dim wbTarget As Object

Set wbTarget = Workbooks.Open(“C:Test汇总结果.xlsx”)

使用完后，True为保存关闭，False为不保存关闭，根据是情况选择

wbTarget.Close SaveChanges:=True

读取Excel文件内容

针对上一步打开的文档，即wbTarget变量指向新打开的Excel文档，可以通过wbTarget逐层获取该Excel文档对应的Sheet、Range、cells 。

如wbTarget.Sheets(1)，即指向的是第一个Sheet表单，当无法确定第一个Sheet表单的名字时，这种方法很方便，如果确定Sheet表单的名字，也可以使用wbTarget.Worksheets(“Sheet1”),到这里是不是就很熟悉了呢？

Excel文档之间复制粘贴数据

复制粘贴数据有很多种方法，可以通过剪切板也可以通过数组，相比之下剪切板使用方便一些，可以支持整片区域的复制、也可以按行复制，数据量小的话也是不错的选择

代码中就是使用的按行复制，也可以通过简单的修改代码实现按区域复制，这样大家可以亲身体会两者的区别，比较优劣

对应代码行41~57，即For循环处开始

代码入口设计

考虑使用方便，还是选取在Sheet页面插入命令按钮(Active x控件)

第一步：Excel文件首先要另存为.xlsm格式文件，第一次打开.xlsm文件会有安全警告，选择启用即可

第二步：顺次选择工具栏 –开发工具–插入–命令按钮（Active X控件），在表单中的适当位置拖动鼠标即可插入。如果该步骤有问题，可以查看我前期写的公众号文章，里面有详细的步骤：如何快速开始编程还不用搭建环境，那一定就是它了……

第三步：双击添加的命令按钮，快速打开VBA代码并且默认会创建类似如下的两行代码，然后我们只要在中间添加代码就可以通过命令按钮调用了

Private Sub CommandButton1_Click()

End Sub

各种与用户交互的参数设置直接通过表格输入，整体显示如下

代码实现

源码如下，都是编程基础知识

''引用Microsoft Scripting Runtime库
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim iRow As Integer
    
    Set ws = Worksheets("Sheet1")
    
    '根据目标路径获取Excel文件
    Dim Filename As String
    Dim SourcePath As String
    SourcePath = ws.Cells(5, 2).Value 'B5单元格获取待合并Excel路径
   
    Filename = Dir(SourcePath & "*.xlsx") '传入路径
    If Filename = "" Then '指定路径下没有Excel文件
        MsgBox "路径下没有Excel文件，请核对后再执行，程序退出！" '提示没有Excel文件，程序退出
        Exit Sub
    End If
    
    iRow = 6 '获取待合并Excel文件列表，从6行保存，方便核对
    Do While Filename <> ""
        ws.Cells(iRow, 2).Value = SourcePath & "" & Filename '拼接全路径，并输入到B列（13行开始）
        iRow = iRow + 1  '下一行'Debug.Print fileName
        Filename = Dir 'Dir
    Loop
    
    '打开目标Excel
    Dim wbTarget As Object
    Dim TargetPath As String
    Dim TargetSheet As Worksheet
    Dim BeginRow As Integer
    TargetPath = ws.Cells(3, 2).Value & "" & ws.Cells(4, 2).Value & ".xlsx" 'B3 B4单元格获取待合并Excel路径
    Set wbTarget = Workbooks.Open(TargetPath, UpdateLinks:=0, ReadOnly:=False) '打开指定的Excel文件
    Set TargetSheet = wbTarget.Sheets(1) '设置目标区域，默认第一个Sheet
    BeginRow = 1
    
    '读取源文件数据
    Dim wbSource As Object
    Dim n As Integer
    Dim SourceSheet  As Worksheet
    Dim lastRow As Integer
    Dim lastColumn As Integer
    For n = 6 To iRow - 1 '循环控制Excel文件
        SourcePath = ws.Cells(n, 2).Value
        Set wbSource = Workbooks.Open(SourcePath, UpdateLinks:=0, ReadOnly:=True)  ''打开指定的Excel文件,只读方式，不可见
        Application.ScreenUpdating = False
        
        Set SourceSheet = wbSource.Sheets(1) '设置目标区域，默认第一个Sheet
        lastRow = SourceSheet.Cells(SourceSheet.Rows.Count, 1).End(xlUp).Row
        Dim dRow As Integer
        For dRow = 1 To lastRow
            SourceSheet.Rows(dRow).Copy
            TargetSheet.Range("A" & BeginRow - 1 + dRow).PasteSpecial xlPasteAll ' 仅复制值"   xlPasteAll xlPasteValues
        Next dRow
        
        wbSource.Close SaveChanges:=False '源Excel文件只读取，不保存关闭
        Set wbSource = Nothing
        BeginRow = BeginRow + lastRow '下一个复制位置
    Next n
    
    ' 关闭目标Excel
    wbTarget.Close SaveChanges:=True '目标Excel文件保存关闭
    Set wbTarget = Nothing

    MsgBox "完成合并"
End Sub