簡單粗暴-將多個excel匯總到一個excel的sheet


首先將待合並的excel都放到一個文件目錄下

新建一個excel右鍵sheet查看代碼 復制如下代碼

Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xlsx")
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(1).Copy sh.[a65536].End(xlUp).Offset(1) '這種寫法只保留第一個文件的表頭
'sht.[a1].CurrentRegion.Copy sh.[a65536].End(xlUp).Offset(1) 這種會提取所有行信息
'2007版及以后可以改成a1048576 但不建議,最好取多個文件有值的最大行數
End If
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "當前工作簿下的全部工作表已經合並完畢!", vbInformation, "提示"
End Sub

參考如下並整理

作者: 知乎用戶
鏈接:https://www.zhihu.com/question/20366713/answer/109112356
來源: 知乎


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM