VBA Excel 文件合并

VBA Excel 文件合并

温馨提示:本文最后更新于2024-12-17 21:15:50,某些文章具有时效性,若有错误或已失效,请在下方留言
Sub Summary_Click()
    '定义合并文件夹目录;
    Dim path As String

    '标题头只运行一次
    Dim once As Integer
    once = 1

    '定义合并总表的文件名
    Dim activeName As String

    '定义当前文件夹当前检查获取的文件名
    Dim xlsxName As String

    '定义wb存储获取的工作簿
    Dim Wb As Workbook

    '关闭屏幕更新,优化合并效率
    Application.ScreenUpdating = False

    '获取当前合并总表的目录, 'E:\多表本合并'
    path = ActiveWorkbook.path

    '获取当前合并后总表的文件名
    activeName = ActiveWorkbook.Name


    '获取path路径下的所有'.xlsx'文件名,'E:\多表本合并\*.xlsx'
    xlsxName = Dir(path & "\" & "*.xlsx")

    '当前文件夹内的xlsx文件未遍历完
    Do While xlsxName <> ""
        '并且当前访问的不是总表
        If xlsxName <> activeName Then
            '依次打开每一个xlsx文件
            Set Wb = Workbooks.Open(path & "\" & xlsxName)

                '使用了With,也可以不使用,将三行合成一行代码
                'Wb.Sheets(1).Range("2:2").Copy ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Range("B65536").End(xlUp).Row + 1, 1)
                With ThisWorkbook.Worksheets(1)
                    '将打开的表格的第二列(除去表头),赋值到总表当前总表已有数据的下一行
                    'Wb.Sheets(1).Range("2:2").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
                    If once = 1 Then
                        ThisWorkbook.Worksheets(1).Range("A1:U1") = Array("序号", "方案编号", "case 编号", "研究中心编号", "受试者编号", "发生国家", "安全性事件的首选术语", "申办方获知时间", "报告类型(初始/随访)", "SAE 标准", "事件发生日期", "事件结束日期", "对试验药物采取的措施", "预期/非预期", "事件转归", "相关性判断-研究者判断", "相关性判断-公司判断", "性别", "出生年份", "本报告生成时间", "7/15 天报告")
                        once = 2
                    End If
                    ' 从A3单元格开始
                    Wb.Sheets(1).Range("A4", Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

        End With

        '关闭当前遍历的工作簿,不保存
        Wb.Close False

    End If

    '调用Dir函数,找到当前目录的下一个xlsx文件
    xlsxName = Dir

Loop

'恢复幕更新
Application.ScreenUpdating = True

End Sub

© 版权声明
THE END
喜欢就支持一下吧
点赞12 分享
评论 抢沙发

请登录后发表评论

    暂无评论内容