Sub 合并當前目錄下所有作業簿的全部作業表()
Dim mypath, myname, awbname
Dim wb As Workbook, wbn As String
Dim g As Long
Dim num As Long
Dim box As String
Application.ScreenUpdating = False
myname = ActiveWorkbook.Path
myname = Dir(mypath & "\""*.xls")
awbname = ActiveWorkbook.Name
num = 0
Do While myname <> ""
If myname <> awbname Then
Set wb = Workbook.Open(mypath & "\" & myname)
num = num + 1
With Workbooks(1).ActiveSheet.Cells(.Range("A65536").End(xlUp).Row + 1, 1) = Left(myname.Len(myname) - 4)
For g = 1 To wb.Sheets.Count
k = k + 1
If k = 1 Then
wb.Sheets(g).used Range.Copy.Cells(.Range("B" & Row.Count).End(xlUp).Row + 1, 1)
Else
wb.Sheets(g).used Range.Offset(1, 0).Copy.Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 1)
End If
Next
wbn = wbn & Chr(13) & wbname
wb.Close False
End With
End If
myname = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & num & "個作業薄下的全部作業表。如下:" & Chr(13) & wbn, vbInformation, "提示"
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/28647.html
標籤：VBA