Sub MergeBook()
Dim MyPath$, MyName$, wb As Workbook, sh As Worksheet, sht As Worksheet
Set wb = ThisWorkbook
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Name <> ActiveSheet.Name Then sh.Delete
Next
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With GetObject(MyPath & MyName)
For Each sht In .Sheets
sht.Copy After:=wb.Sheets(wb.Sheets.Count)
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
我想做完第一個marco後
開一個叫combile sheets
把combile sheets 移到最後的sheets
run 巨集8
巨集8 run 令MergeBook()讀入excel file 合併
我想把兩個marco合起來
做到兩個marco功能
Sub 巨集8()
'
' 巨集8 巨集
'
'
mysheets = ActiveWorkbook.Sheets.Count - 4
myworksheets = ActiveWorkbook.Worksheets.Count - 4
For i = 1 To myworksheets
Sheets(i).Select