VBA一键汇总多个工作簿-名称相同的工作表-的指定区域数据

日常工作，我们经常需要汇总相同格式的工作簿的某个工作表的数据

如1月业绩、2月业绩。。。。12月业绩等

姓名	数量
数据22	22
数据23	23
数据24	24
数据25	25
数据26	26
数据27	27
数据28	28
数据29	29
数据30	30
数据31	31
数据32	32
数据33	33
数据34	34
数据35	35
数据36	36
数据37	37
数据38	38
数据39	39
数据40	40

VBA汇总后变成这样：

 啥也不说了，直接拿代码去用

 Dim 所有工作簿列表 As FileDialogSelectedItems
    Private Sub 提取数据按钮_Click(sender As Object, e As EventArgs) Handles 提取数据按钮.Click


        Dim dic As Object = CreateObject("scripting.dictionary")
        Dim wb As Excel.Workbook
        Dim sht As Excel.Worksheet
        Dim j As Long

        With App.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFilePicker)
            .AllowMultiSelect = True
            .Title = "可选择多个工作簿"

            If .Show() = -1 Then
                所有工作簿列表 = .SelectedItems              '记录所有工作簿，防止二次选择工作簿
                For Each 工作簿路径 As String In .SelectedItems

                    wb = App.Workbooks.Open(工作簿路径)
                    For Each sht In wb.Worksheets
                        dic(sht.Name) = ""
                    Next

                    wb.Close(False)
                Next

                '将所有表名加载
                For Each 表名 In dic.keys
                    ComboBox2.Items.Add(表名)           '适合汇总同工作表名称的汇总
                Next

            End If
        End With
    End Sub

    Private Sub 汇总数据按钮_Click(sender As Object, e As EventArgs) Handles 汇总数据按钮.Click
        Dim wb As Excel.Workbook
        Dim sht As Excel.Worksheet
        Dim j As Long


        Dim 开始输出单元格 As Excel.Range = App.InputBox("请选择开始输出单元格", Type:=8)
        Dim 输出表 As Excel.Worksheet = App.ActiveSheet

        For Each 工作簿路径 As String In 所有工作簿列表

            wb = App.Workbooks.Open(工作簿路径)
            For Each sht In wb.Worksheets
                If sht.Name = ComboBox2.Text Then
                    Dim lastrow As Long = 输出表.Cells(输出表.Rows.Count, 开始输出单元格.Column).end(Microsoft.Office.Interop.Excel.XlDirection.xlUp).row + 1      '最后一行
                    sht.Range(ComboBox3.Text).Copy(输出表.Cells(lastrow, 开始输出单元格.Column))      '尽量不要整列，否则可能出错
                End If
            Next

            wb.Close(False)
        Next
    End Sub

    Private Sub 选择单元格按钮_Click(sender As Object, e As EventArgs) Handles 选择单元格按钮.Click
        ComboBox3.Text = App.InputBox("请选择汇总区域", Type:=8).address
    End Sub

我的窗体界面是这样的

 

希望大家多多支持！谢谢