是否可以從存盤在同一檔案夾中的作業簿中的所有 excel 作業表中附加資料(所有作業簿具有相同的選項卡/作業表名稱,我想附加來自特定作業表/選項卡名稱的所有資料)。但是,作業簿有不同的名稱。
uj5u.com熱心網友回復:
請嘗試下一個代碼。它在 中的所有作業簿之間迭代strFold,打開它們(使用密碼)并將每個作業表內容復制到對應的主表格中。僅為第一個作業簿復制標題。它假定標題存在于第一行并且復制的范圍從 A:A 列開始:
Sub UpdateAllSheetsWbFolder()
Dim strFold As String, wbName As String, wb As Workbook, wbM As Workbook, ws As Worksheet, wsM As Worksheet
Dim lastR As Long, lastRM As Long, lastCol As Long, i As Long
Const pass As String = "12345" 'use here your real password!
Set wbM = ActiveWorkbook ' if the master one keeps this code: set wbm = ThisWorkbook
strFold = "C:\...your folder path\" 'take care to end in backslash "\" !!!
wbName = Dir(strFold & "*.xls*")
Application.ScreenUpdating = False
Do While wbName <> ""
Set wb = Workbooks.Open(strFold & wbName, Password:=pass)
i = i 1
For Each ws In wb.Worksheets
Set wsM = wbM.Worksheets(ws.name)
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
lastRM = wsM.Range("A" & wsM.rows.count).End(xlUp).row
lastCol = ws.cells(1, ws.Columns.count).End(xlToLeft).Column
With ws.Range(ws.cells(IIf(i = 1, 1, 2), "A"), ws.cells(lastR, lastCol))
wsM.Range("A" & lastRM IIf(lastRM = 1, 0, 1)).Resize(.rows.count, .Columns.count).Value = .Value
End With
Next ws
wb.Close False 'close it without saving
wbName = Dir()
Loop
Application.ScreenUpdating = True
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/qiye/515452.html
標籤:擅长vba
上一篇:如何遍歷每個標簽并在Excelvba中更改其邊框樣式?
下一篇:VBAMsgBoxIF陳述句?
