合并多個Excel到一個Excel的Sheet

作者: liangdong 分类: 杂谈 发布时间: 2020-02-17 16:17
Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls")
Application.ScreenUpdating = False
Cells.ClearContents
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With GetObject(MyPath & MyName)
For Each sht In .Sheets
If IsSheetEmpty = IsEmpty(sht.UsedRange) Then
m = m + 1
If m = 1 Then
sht.[a1].CurrentRegion.Copy sh.[a1]
Else
sht.[a1].CurrentRegion.Offset(0).Copy sh.[a65536].End(xlUp).Offset(1)
End If
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub

今天需要幫老婆處理一個事情,把多個Excel合并在一個Excel中,可以用以上的VBA脚本。

如果觉得我的文章对您有用,请随意赞赏。

发表评论

电子邮件地址不会被公开。 必填项已用*标注