日常工作中,我们有时候会需要将多份相同格式的工作簿合并到一个工作表中,进行数据分析和处理.
这时候,如果你一个个的打开粘贴,是非常耗时和耗费精力的.而且手工操作,免不了偶尔出个错,到了最后发现数据不对,一条条核对时候,就会在想,有没有什么操作,可以让你的双手解放一些呢?答案就是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
