ExcelVBA_002 多簿汇总

一、需求说明

        将不同工作簿（文件）但是结构相同的工作表内容复制粘贴到一个总表中。

如下图购票1，购票2，购票3表格结构相同，需要将内容复制到购票汇总内。

二、实现思路

    （1）用dir与 Do While……Loop循环语句配合循环同文件夹下的购票1、购票  2、购票3等多个文件。

    （2）利用Range.Copy方法，将三个部门的信息复制到总表里。

三、实现代码

    

Public Sub GatherDataPasteAdd()

    '声明变量

    Dim Wb As Workbook, Sht As Worksheet

    Dim OpenWb As Workbook, OpenSht As Worksheet

    Const SHEET_INDEX = 1, HEADER_ROW = 1 '设置工作表序号与标题行数

    Dim FolderPath, FileName, FileIndex

    '变量赋值

    Set Wb = Application.ThisWorkbook

    Set Sht = Wb.ActiveSheet

    '预先清除当前工作表

    Sht.Cells.Clear

    '获取当前工作簿文件夹路径

    FolderPath = Wb.Path & '\'

    FileIndex = 0

    '循环所有工作簿

    FileName = Dir(FolderPath & '*.xls*')

    Do While FileName <> ''

        If FileName <> ThisWorkbook.Name Then '当前工作簿排除在外

            FileIndex = FileIndex 1

            Set OpenWb = Application.Workbooks.Open(FolderPath & FileName)

            Set OpenSht = OpenWb.Worksheets(SHEET_INDEX)

            '第一个工作簿需要连标题一起复制

            If FileIndex = 1 Then

                OpenSht.UsedRange.Copy Sht.Range('A1')

            Else

            '第二个工作开始需要去除标题

                OpenSht.UsedRange.Offset(HEADER_ROW).Copy Sht.Range('A' & Sht.Rows.Count).End(xlUp).Offset(1)

            End If

            OpenWb.Close True

        End If

        FileName = Dir

    Loop

    '释放对象

    Set Wb = Nothing: Set Sht = Nothing

    Set OpenWb = Nothing: Set OpenSht = Nothing

End Sub

四、实现效果

五、佛系打赏