Home > Software engineering >  Combine all worksheets in folder VBA
Combine all worksheets in folder VBA

Time:10-14

Is it possible to append data from all excel worksheets within workbooks stored in the same folder (all workbooks have the same tab/sheet names and I want to append all data from a specific sheet/tab name). Workbooks have different names though.

CodePudding user response:

Please, try the next code. It iterates between all workbooks in strFold, open them (using password) and copy each sheet content in the correspondent one form the master. The header is copied only for the first workbook. It assumes that the headers exists on the first row and copied ranges start from A:A column:

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
  • Related