ActiveWorkbook.SaveAs "\\C:\Users\curryjeng\Desktop\自動合併.xlsx"
i = 1
Workbooks(Filename).Close
Else
Sheets(1).Copy After:=Workbooks("自動合併.xlsx").Sheets(1)
Workbooks(Filename).Close
End If
' 每個Sheet都複製
' For Each Sheet In ActiveWorkbook.Sheets
' Sheet.Copy After:=ThisWorkbook.Sheets(1)
' Next Sheet
Application.ScreenUpdating = True
End Sub作者: abc9gad2016 時間: 2019-11-1 17:53
抱歉沒改到已無法編輯,紅字範圍為以下迴圈的地方
Do While Filename <> ""
Workbooks.Open Path & "\" & Filename
If i <> 1 Then '第一個檔案另存成全部
Sheets(1).Copy '存檔路徑 & 名稱 & 格式
ActiveWorkbook.SaveAs "\\C:\Users\curryjeng\Desktop\自動合併.xlsx"
i = 1
Workbooks(Filename).Close
Else
Sheets(1).Copy After:=Workbooks("自動合併.xlsx").Sheets(1)
Workbooks(Filename).Close
End If