日志

日常工作中,我们有时候会需要将多份相同格式的工作簿合并到一个工作表中,进行数据分析和处理.

这时候,如果你一个个的打开粘贴,是非常耗时和耗费精力的.而且手工操作,免不了偶尔出个错,到了最后发现数据不对,一条条核对时候,就会在想,有没有什么操作,可以让你的双手解放一些呢?答案就是VBA.

下面一份代码,就是阁主写来合并多个工作簿的.现在放出来,以飨读者.

疏漏之处,还请包涵~

有问题欢迎指出,至于改不改嘛~看我心情.

Sub 合并文件()
    '注意,合并多个工作簿到当前激活工作簿的激活工作表,而不是代码所在工作簿
    '副作用:本代码有两项副作用,1是会取消所有的合并单元格,2是会取消所有的筛选,使用前,请确认是否可以接受.(可以放心的是,数据源工作簿并不会发生改变)
    Dim actWb As Workbook, actSh As Worksheet
    Set actWb = ActiveWorkbook
    Set actSh = ActiveSheet
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = True Then
            Dim arrs
            Set arrs = .SelectedItems
        End If
        
    End With
    Dim s
    For Each s In arrs
        Dim obj
        Set obj = GetObject(s)
        Dim Sh As Worksheet
        For Each Sh In obj.Sheets
            '这里会遍历工作簿的所有的工作表,如果只需要遍历指定的工作表,请添加if条件
            'if sh.name="Sheet1" then
            Sh.Cells.UnMerge
            On Error Resume Next
            Sh.Cells.AutoFilter
            Sh.UsedRange.Copy actSh.Range("a1").Offset(actSh.UsedRange.Rows.Count + actSh.UsedRange.Row - 1, 0)
            If Err.Number <> 0 Then
                Debug.Print Err.Description & vbCrLf & Sh.Parent.Name & vbTab & Sh.Name
            End If
            On Error GoTo 0
            'end if
        Next
        obj.Close (False)
        Set obj = Nothing
        Set Sh = Nothing
    Next
End Sub