Excel VBA - Append multiple tabs form multiple worksheets into one master spreadsheet

MBD

New Member
Joined
Aug 25, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Hi all, I have tried combining and modifying different codes posted previously in this forum but couldn't work out how to exactly tailor it to my requirement.
I understand that my requirement is quite complex - would appreciate if anyone can help with this:

I'm trying to append multiple tabs from multiple spreadsheets into one master spreadsheet (exact same tab names, the order doesn't matter).
- each source spreadsheets contains different names, however there's a pattern to it (starts with either P- or C-)
- each source spreadsheets contains three tabs (tab names are: Roster, Change, Booking) to be appended into master spreadsheet with the same tab names
- there are three different folders source for the spreadsheets :
C:\Users\Marco\Desktop\BookingReport\Team1
C:\Users\Marco\Desktop\BookingReport\Team2\Red
C:\Users\Marco\Desktop\BookingReport\Team2\Blue


Essentially, each tab from source spreadsheet contains differing number of datalines (sometimes none).
For each tabs, I'm trying to append (copy paste as value) datalines from columns A to E , row 3 onwards, only if there are data (e.g. A3:E5 if there are three lines of data, if cell A3 is blank, don't copy paste anything)
Additionally, I need to add a new column to each dataline containing the first 6 characters of the file name (e.g. if file name is 'P-1234 evening roster' then the new column would have 'P-1234' in it)

Thank you in advance - really appreciate any help.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,707
Office Version
  1. 2010
Platform
  1. Windows
MBD,
You might consider the code below. Be advised, though - it's untested... I did not want to create sample folders, files, sheets and data.

VBA Code:
Sub MasterWorkbook()
Application.ScreenUpdating = False
Dim arr As Variant, i As Long
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim folderName As String, fileName As String, chr As String
Dim lastRow1 As Long, lastRow2 As Long, kount As Long

arr = Array("C:\Users\Marco\Desktop\BookingReport\Team1\", _
    "C:\Users\Marco\Desktop\BookingReport\Team2\Red\", _
    "C:\Users\Marco\Desktop\BookingReport\Team2\Blue\")

Set wb1 = ThisWorkbook
For i = 0 To 2
    folderName = arr(i)
    fileName = Dir(folderName & "*.xlsx")
    Do While fileName <> ""
        chr = Left(fileName, 1)
        If fileName <> wb1.Name And chr = "P" Or chr = "C" Then
            Set wb2 = Workbooks.Open(folderName & fileName)
                For Each ws2 In wb2.Worksheets
                    For Each ws1 In wb1.Worksheets
                        If ws2.Name = ws1.Name Then
                            If ws2.Range("A3") <> "" Then
                                lastRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
                                lastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
                                kount = lastRow2 - 2
                                ws2.Range("A3:E" & lastRow2).Copy
                                ws1.Range("A" & lastRow1 + 1).PasteSpecial Paste:=xlPasteValues
                                ws1.Range("F" & lastRow1 + 1 & ":F" & lastRow1 + 1 + kount).Value = Left(fileName, 6)
                            End If
                            Exit For
                        End If
                    Next ws1
                Next ws2
            wb2.Close savechanges:=False
        End If
    fileName = Dir
    Loop
Next i

Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub
 
  • Like
Reactions: MBD
Solution

MBD

New Member
Joined
Aug 25, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Thank you tonyyy for your reply.
I've tried your code, however the result sheet doesn't pop up for some reason.

I tried a few things but couldn't figure out what's missing - any idea what that may be?
 

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,707
Office Version
  1. 2010
Platform
  1. Windows
Where did you install the code? In a new workbook? In a regular module? What happens when you try to run it? Are there any error messages?
When you say you "tried a few things" - what did you try?
As I originally mentioned, I did not create sample data files so I'm not able to test the code.
 

MBD

New Member
Joined
Aug 25, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Hi tonyyy - apologies for the late reply, I have been off sick and just back working on this project

After looking at your code closely again, I figured the reason why it's not working was because I created a new blank workbook, where your code specified the condition "If ws2.Name = ws1.Name Then"
I added the worksheets and named them and now the code works like a charm!

Massive thank you for your help - you're a life saver!
 

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,707
Office Version
  1. 2010
Platform
  1. Windows
Happy you got it working. You're very welcome.

Oh... please check the Mark as Solution so others will know your question is solved. Thanks.
 
Last edited:

MBD

New Member
Joined
Aug 25, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Done - thanks for letting me know tonyyy!
 

Forum statistics

Threads
1,147,562
Messages
5,741,848
Members
423,691
Latest member
Fahad987

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top