Copying data from several worksheets in one book, to a master workbook

Umm. Nort sure I fully understand about the headers etc

Do you want the ability, once you've created the master workbook, to update it ONLY with data that has been added to the "satellite" workbooks since last update?

The first thing you need to do is to setup your Master workbook. If you only want the headers the first time that means that you don't want to copy the headers. You want them to be there already. You should create your Master workbook with all the headers and sheets that it needs and put the macro in the Master workbook. then you can call the macro with a button.

Having said that we need more information to be able to help. Right now we can't give more than generalizations because we have no info. What workbooks do you have?
What worksheets on each one need copying?
From what row do they need to be copied?
Are they all going to be copied to the same sheet in the Master or to separate sheets?
Are you wanting to copy the formulas (if there are any)?

Can you post some example workbooks for us to get started with?

Thanks so much for such quick responses - much appreciated.

Neil - as Mike assumed I just want the headers once not 20 times, more than happy to create the master and just have the macro in the master file.

Do you want the ability, once you've created the master workbook, to update it ONLY with data that has been added to the "satellite" workbooks since last update?  - not sure I understand - yes there will be changes but not sure how Excel would know what had been changed so assumed I would just need to re run the whole macro again, if one of the source files needed to be updated.  So maybe a clear function of existing data may be useful to avoid duplicate records?

Mike - attached a dummy file - all pink and purple tabs need to be consolidated.

In the master I would then end up with 15 data tabs (all the pink and purple ones) appended for my 20 files - does that make sense?
No formulas wanted paste special values would be great.

Thanks so much guys.

Pippa
ZBB-Model-DE.xlsx

The method in VBA that you want to use is xltransferspreadsheet. You'd need to write code that stores your data range on each sheet as a variable, finds the last row +1 on your master sheet, and copy your data range from each sheet and paste using xltransferspreadsheet.

But how can you do this if the data on each worksheet isn't in the same format?

There's a great book that explains this whole process called VBA And Macros for Microsoft Excel by Wrox publishing, but it is a multichapter topic. Even if someone posted code to get you closer to your goal, you'd still need to understand it.

Thanks Ron - all the data on each sheet is the same format just one sheet to another vary.  If you see the file I have uploaded I am trying to consolidate 20 workbooks of the pink and purple tabs only, to one master workbook with all the pink and purple tabs with the 20 submissions appended.

Any help greatly appreciated to save a lot of copy and pasting.

Thanks Pippa

This is what the master file would look like -  only after the data from my 20 submission files to go into pink and purple tabs, appended.

Thank you
ZBB-Master-Model-Round-1.xlsx

Here is an example of what you can do. I only did one sheet since I don't know the names of the other workbooks and the sheets that they have:

Sub CopySheets()
    Dim wbMaster As Workbook, wbTravel As Workbook
    Dim wsTravel As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
    
    Set wbMaster = Workbooks.Application.ActiveWorkbook
    Set wsTravel = wbMaster.Worksheets("Travel")
    
    Set wbTravel = Workbooks.Application.Workbooks("Travel")
    
    LastRow = wsTravel.Cells(wsTravel.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wbTravel.Sheets("Sheet1").Cells(wbTravel.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    DataRange = wbTravel.Sheets("Sheet1").Range("A10:KP" & LastDataRow)
    
    wsTravel.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Select allOpen in new window

For more info about the PasteSpecial.

Thanks Mike - I have added the code into my mater file  and its falling over at :

Set wbTravel = Workbooks.Application.Workbooks("Travel") saying error 9, subscript out of range.

Is this because the workbook I am trying to copy data from is called ZBB Model DE and the sheet is called travel?

Both master file and ZBB Model DE examples are now in the thread.

Thanks so much

Pippa

Pippa - yes. You would need to amend Mike's code to your workbook names.

The code also assumes that you already have the workbooks you want to copy from open.

Thanks Neil - sorry I am very rusty on macros - so to get this to work, guessing I change this to point to the file being uploaded ZBBModelDE  (I have renamed removing spaces) and pointing to the travel sheet?  But its still not happy - what am I doing wrong?

  Set wbZBBModelDE = Workbooks.Application.Workbooks("Travel")

Thank you so much for your time

Pippa

You will have to set the workbook variable to the workbook, not the sheet:

Set wbZBBModelDE = Workbooks.Application.Workbooks("ZBBModelDE")

Select allOpen in new window

and then when you are referencing this workbook later you will have to specify the sheet or easier create a worksheet variable like:

Dim wsTravelZBBModelDE as worksheet
set wsTravelZBBModelDE = wbZBBModelDE.sheets("Travel")

Select allOpen in new window

Then you only have to use the wsTravelZBBModelDE to reference that sheet in that workbook.

I only gave a brief outline because of the lack of details that were provided. You will have to modify the script to include the other workbooks and to get all the names correct. I don't have that information so I made do with sample names based on what you did provide.

Thanks Mike - but I am still stuck, now the macros stops one step earlier :-(

Really appreciate your help -  I can then add on all the other sheets.

Thanks you Pippa

Sub CopySheets()
    Dim wbMaster As Workbook, wbZBBModelDE As Workbook
    Dim wsTravelZBBModelDE As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
   
    Set wbMaster = Workbooks.Application.ActiveWorkbook
    wsTravelZBBModelDE = wbZBBModelDE.Sheets("Travel") - The marco now stops here
   
    Set wbZBBModelDE = Workbooks.Application.Workbooks("ZBBModelDE")
   
    LastRow = wsTravel.Cells(wsTravel.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wbZBBModelDE.Sheets("Travel").Cells(wbZBBModelDE.Sheets("Travel").Rows.Count, "A").End(xlUp).Row
    DataRange = wbZBBModelDE.Sheets("Travel").Range("A10:KP" & LastDataRow)
   
    wsTravel.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Hi Pippa.. you need to move the line:

Set wbZBBModelDE = Workbooks.Application.Workbooks("ZBBModelDE")

Select allOpen in new window

to above the assignment of the travel worksheet, and remove the first use of the word "Workbooks".
You can set wbMaster by just referencing "ActiveWorkbook" on its own.

You also need a "set" command for the travel worksheet, because it is an "object".

So:

Set wbMaster = ActiveWorkbook
Set wbZBBModelDE = Application.Workbooks("ZBBModelDE")
Set wsTravelZBBModelDE = wbZBBModelDE.Sheets("Travel")  

Select allOpen in new window

By the way, if you are posting code it is really helpful to use the "Code" button in the comment box.. this formats it much more readably.

Thanks Neil - sorry learning fast!  Hope this is what you meant and I clicked the CODE option.

[Sub CopySheets()
    Dim wbMaster As Workbook, wbZBBModelDE As Workbook
    Dim wsTravelZBBModelDE As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
    
    Set wbMaster = ActiveWorkbook
    Set wbZBBModelDE = Application.Workbooks("ZBBModelDE")
    Set wsTravelZBBModelDE = wbZBBModelDE.Sheets("Travel")
    
    
    
    LastRow = wsTravel.Cells(wsTravel.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wbZBBModelDE.Sheets("Travel").Cells(wbZBBModelDE.Sheets("Travel").Rows.Count, "A").End(xlUp).Row
    DataRange = wbZBBModelDE.Sheets("Travel").Range("A10:KP" & LastDataRow)
    
    wsTravel.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Select allOpen in new window

Its still stopping at the second set line, I have the files both open - not sure what I am doing wrong.  Thank you so much

PIppa

Sorry, Pippa. You need the full name of the workbook file, which I hadn't noticed wasn't there.

Assuming it's an .xlsx file:

Set wbZBBModelDE = Application.Workbooks("ZBBModelDE.xlsx")

Select allOpen in new window

Sorry, Pippa gets busy around here. You do have to use the full name of the workbooks as you try to call them. I am using partial names only as an example. I should have used full names to better show what is happening. Each workbook that you connect to and each sheet in each workbook will need to have its full name with the same capitalization for it to work.

it is usually best to make your workbook and worksheet variable names something that is easy to remember and descriptive enough that you know what they are without having to refer back to where you set them. That way you can continue to program the rest without having to constantly scroll back up to the beginning to see what each variable means and what you are using it for. Then once you have all the names decided on it'll be as simple as copy/paste to duplicate the process over and over till you have all the workbooks setup in the Master.

The way that I usually do it is to have all the Workbook variables on one line, all the Worksheet variables on one line, and if there are a lot of other variables I divide them up based on either when I'm going to use them or on variable type. In the case of what you are trying to do here, you will end up with at least 3 lines of variables if you keep to the way that I have it currently.

You can also use your own convention to make it easy for you to understand as long as it works and is setup with the correct order. Another thing you will want to consider is making comments in the VBA so that when you come back to it later you will be able to tell what is happening by reading the comments.

Thanks Neil for helping out quickly while I'm away.

Morning Mike and Neil,

Thanks you both so much for all your help, I am getting closer!  But still stopping now the second line from the end.  

Neil - Thank you so much for you ideas on my multi workbook issues, I will play with that after I have this part working - I am sure I will have questions.

Sub CopySheets()
    Dim wbMaster As Workbook, wbZBBModelDE As Workbook
    Dim wsTravelZBBModelDE As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
    
    Set wbMaster = ActiveWorkbook
    Set wbZBBModelDE = Application.Workbooks("ZBBModelDE.xlsx")
    Set wsTravelZBBModelDE = wbZBBModelDE.Sheets("Travel")
    
    
    
    LastRow = wsTravelZBBModelDE.Cells(wsTravelZBBModelDE.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wbZBBModelDE.Sheets("Travel").Cells(wbZBBModelDE.Sheets("Travel").Rows.Count, "A").End(xlUp).Row
    DataRange = wbZBBModelDE.Sheets("Travel").Range("A10:KP" & LastDataRow)
    
    wsTravel.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Select allOpen in new window

Thanks again Pippa

Hi Pippa:
I don't think you have defined a worksheet called "wsTravel". It needs to be in the "Dim" declarations and then set to the "travel" worksheet of wbMaster after you have set wbMaster.

If I were you, to be honest, I would simplify the names. Call the source workbook "wbSource" and the source worksheet "wsSource", or something. You will want to re-use this code for all the imports, so it doesn't make sense to name the variable after a particular sheet.

Because the names are confusing, it looks for instance as if the code to get "LastDataRow" does not make use of the fact you have already set  a source worksheet. You are referencing the workbook and sheet, instead of the sheet directly, via wsTravelZBBModelDE.

Morning Neil, Okay I have added a Di and a Set as suggested (I think correctly).  However still stopping on the second to last row :-(

I adefinatley gree this is getting complicated especially when I then expand for 12 sheets and 20 workbooks - thankfully your code may help with the 20 Workbook part.  I think I understand WbSource - just replacing WbMaster but WsSource don't think I understand as on this case it will be travel, the next sheet will be Recruitment and then Learning etc

Sub CopySheets()
    Dim wbMaster As Workbook, wbZBBModelDE As Workbook
    Dim wsTravelMaster As Worksheet
    Dim wsTravelZBBModelDE As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
    
    Set wbMaster = ActiveWorkbook
    Set wsTravelMaster = wbMaster.Sheets("Travel")
    Set wbZBBModelDE = Application.Workbooks("ZBBModelDE.xlsx")
    Set wsTravelZBBModelDE = wbZBBModelDE.Sheets("Travel")
    
    
    
    LastRow = wbMaster.Sheets("Travel").Cells(wbMaster.Sheets("Travel").Rows.Count, "A").End(xlUp).Row
    LastDataRow = wbZBBModelDE.Sheets("Travel").Cells(wbZBBModelDE.Sheets("Travel").Rows.Count, "A").End(xlUp).Row
    DataRange = wbZBBModelDE.Sheets("Travel").Range("A10:KP" & LastDataRow)
    
    wbMaster.Sheets("Travel").Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Select allOpen in new window

Thanks Pippa

Attaching the files - with the latest code included. Trying to copy from ZBBModelDE and then ZBBModelUK into ZBBMaster, firstly the travel tab data rows and then the other pink and purple tabs. There will be many more files to copy into the Master but all the same file format.

Thanks so much

Pippa
ZBB-Model-UK.xlsx
ZBBModelDE.xlsx
ZBB-Master-Model-Round-1.xlsm

I've updated the scripts to include the suggestions from Neil. Try these:

Sub CopySheets(ws As Worksheet)
    Dim wbMaster As Workbook
    Dim wsDestination As Worksheet, wsSource As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow
    
    Set wbMaster = ActiveWorkbook
    Set wsDestination = wbMaster.Sheets("Travel")
    Set wsSource = ws
    
    LastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    DataRange = wsSource.Range("A10:KP" & LastDataRow)
    
    wsDestination.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Sub GetAllData()

Dim sWS As String
Dim aWS() As String
Dim iSheet As Long
Dim wB As Workbook, ws As Worksheet
Dim found As Boolean

'list all worksheets you need, regardless of which workbook they are in
sWS = "Travel,Learning,Recruitment,Contractors & Consultants,Comms,Events,Associations,Memberships,Insurance,Audit,C&C and Recruitment"
'split string to array
aWS = Split(sWS, ",")

'loop through array of sheets
For iSheet = 0 To UBound(aWS)
    found = False
    'check each workbook that is open
    For Each wB In Application.Workbooks
        'hunt through sheets
        For Each ws In wB.Sheets
        'if sheet found, call Mike's routine, passing the sheet object to it directly
            If ws.Name = aWS(iSheet) Then
            CopySheet ws
            found = True
            'stop looking in current workbook
            Exit For
        Next
    'stop looking in other workbooks
    If found Then Exit For
    Next
Next
End Sub

Select allOpen in new window

Now you will run the sub GetAllData and it should take you through each sheet. You still have to put this in the Master workbook and run it from there and have the other workbooks open that you are copying data from. There will probably need to be some modification of the copied range as well, but we can work on that once the rest of this is working.

Mike - thanks you so much!  I will test now and revert.  Pippa

Sorry I must be doing something wrong - it stopped first at Copysheet ws - so I added a 's' so Copysheets ws - and it then moved on.
But then stopped at Next with the error 'compile error next without for'

But it didn't seem to do anything in the Master File before it got to Next.  No data copied across for anything.

Thanks Pippa

Where exactly did it stop? There are 3 Next

Sorry - the next after the comment 'stop looking in other workbooks

Pippa

Do you have all the workbooks open? That for loop is supposed to loop through the multiple workbooks.

Hi, yes all workbooks open.  I have attached them if that's easier? Thank you Pippa
ZBB-Master-Model-Round-1.xlsm
ZBBModelDE.xlsx
ZBB-Model-UK.xlsx

Okay, I've taken a look. What happened is Neil forgot to close the If statements with End IF. Here's a working set:

Sub CopySheets(wB As Workbook, ws As Worksheet)
    Dim wbMaster As Workbook, wbSource As Workbook
    Dim wsDestination As Worksheet, wsSource As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow, LastDataColumn, LastDataColumnNum
    
    Set wbMaster = Application.Workbooks("ZBB-Master-Model-Round-1.xlsm")
    Set wsDestination = wbMaster.Sheets(ws.Name)
    Set wbSource = wB
    Set wsSource = wbSource.Sheets(ws.Name)
    
    LastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    LastDataColumnNum = wsSource.Cells(5, wsSource.Columns.Count).End(xlToLeft).Column
    LastDataColumn = Split(Cells(1, LastDataColumnNum).Address, "$")(1)
    DataRange = wsSource.Range("A10:" & LastDataColumn & LastDataRow)
    
    wsDestination.Range("A" & LastRow).PasteSpecial Paste:=xlPasteAll
End Sub

Sub GetAllData()

Dim sWS As String
Dim aWS() As String
Dim iSheet As Long
Dim wB As Workbook, ws As Worksheet
Dim found As Boolean

'list all worksheets you need, regardless of which workbook they are in
sWS = "AP18-BPC-Function-input,Employee Register,Cost Ctr - BPC Function,Travel,Learning,Recruitment,Contractors & Consultants,Comms,Events,Associations,Memberships,Insurance,Audit,C&C and Recruitment"
'split string to array
aWS = Split(sWS, ",")

'loop through array of sheets
For iSheet = 0 To UBound(aWS)
    found = False
    'check each workbook that is open
    For Each wB In Application.Workbooks
        'hunt through sheets
        For Each ws In wB.Sheets
        'if sheet found, call Mike's routine, passing the sheet object to it directly
            If wB.Name = "ZBB-Master-Model-Round-1.xlsm" Then
                Exit For
            End If
            If ws.Name = aWS(iSheet) Then
                CopySheets wB, ws
                found = True
                'stop looking in current workbook
                Exit For
            End If
        Next
    'stop looking in other workbooks
    If found Then
        Exit For
    End If
    Next
Next
End Sub

Select allOpen in new window

I've made a few more updates to the code as well. It will now find the last column and only copy that far for each sheet. The problem I'm having with the copy though is that the sheets all start in a different place, some on row 3 some on row 6 some on row 9. If they all started on the same row it would be easier to get the first row, especially since some of them have data of some sort above the header row.

Thank you so much - I will test now and revert.  The data above the headers doesn't need to be copied over but agree not ideal starting on different rows - any ideas greatly received!

All workbooks open but it stops here: I tried changing the - for _ but still not happy, any ideas?

 Set wbMaster = Application.Workbooks("ZBB-Master-Model-Round-1.xlsm")

Select allOpen in new window

Thanks Pippa

That is probably a because that is not the name of your file. You might have a (1) or something similar in the name. The name has to be exact.

I also found a mistake in my code you will need to change this line:

DataRange = wsSource.Range("A10:" & LastDataColumn & LastDataRow)

Select allOpen in new window

to this:

wsSource.Range("A10:" & LastDataColumn & LastDataRow).Copy

Select allOpen in new window

Thanks so much Mike it works and doesn't stop!  Just some tweaking needed, I have changed to paste special values, shortened the master file name and just focusing on one sheet and then will add back the others as we fix the range issues.

However 2 issues so far:

1)  Only copying in the data from one of the two open files ZBBModelDE not being copied across, but ZBBModelUk is being copied across
2)  The range selected on Travel sheet, currently it stops at column JZ "Other Costs Description" as not populated but I need to capture the data through to column KL - any ideas as I cannot guarantee all columns on the first row will be populated?  Stems to the bigger issue on how I capture the ranges on all the sheets, any guidance greatly received.

I have reattached the latest models with the code attached to the master and pasted below for ease.

Thanks Pippa

Sub CopySheets(wB As Workbook, ws As Worksheet)
    Dim wbMaster As Workbook, wbSource As Workbook
    Dim wsDestination As Worksheet, wsSource As Worksheet
    Dim LastRow, DataRange As Range, LastDataRow, LastDataColumn, LastDataColumnNum
    
    Set wbMaster = Application.Workbooks("ZBBRound1.xlsm")
    Set wsDestination = wbMaster.Sheets(ws.Name)
    Set wbSource = wB
    Set wsSource = wbSource.Sheets(ws.Name)
    
    LastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
    LastDataRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    LastDataColumnNum = wsSource.Cells(5, wsSource.Columns.Count).End(xlToLeft).Column
    LastDataColumn = Split(Cells(1, LastDataColumnNum).Address, "$")(1)
    wsSource.Range("A10:" & LastDataColumn & LastDataRow).Copy
    
    wsDestination.Range("A" & LastRow).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Sub GetAllData()

Dim sWS As String
Dim aWS() As String
Dim iSheet As Long
Dim wB As Workbook, ws As Worksheet
Dim found As Boolean

'list all worksheets you need, regardless of which workbook they are in
sWS = "Travel"
aWS = Split(sWS, ",")

'loop through array of sheets
For iSheet = 0 To UBound(aWS)
    found = False
    'check each workbook that is open
    For Each wB In Application.Workbooks
        'hunt through sheets
        For Each ws In wB.Sheets
        'if sheet found, call Mike's routine, passing the sheet object to it directly
            If wB.Name = "ZBBRound1.xlsm" Then
                Exit For
            End If
            If ws.Name = aWS(iSheet) Then
                CopySheets wB, ws
                found = True
                'stop looking in current workbook
                Exit For
            End If
        Next
    'stop looking in other workbooks
    If found Then
        Exit For
    End If
    Next
Next
End Sub

Select allOpen in new window

ZBBMaster.xlsm
ZBB-Model-UK.xlsx
ZBBModelDE.xlsx

Hi, can anyone help get me over the line with this code?  Thanks so much

Pippa

Hi Pippa,

Below code may help you what you are trying to achieve:

Sub ConsolidateMultipleWorkbooks()
Dim MyPath As String, FilesInPath As String, FileName As String, FileType As String
Dim eRow As Long, LastRow As Long, LastCol As Long
Dim SrcWB As Workbook, TargetWorkbook As Workbook
Dim SrcWs As Worksheet, TargetWs As Worksheet

'Disable Events
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

FileType = "*.xls*"     'The file type to search for

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path
    .AllowMultiSelect = False
    If .Show = -1 Then
        FilesInPath = .SelectedItems(1) & "\"
    Else
        Exit Sub    'Cancel was pressed
    End If
End With
FileName = Dir(FilesInPath & FileType)

Do While FileName <> ""
    Set TargetWorkbook = Application.ThisWorkbook
    Set TargetWs = TargetWorkbook.Worksheets("Travel")
    Set SrcWB = Workbooks.Open(FilesInPath & FileName, False, True)
    Set SrcWs = SrcWB.Worksheets("Travel")
    SrcWs.Activate
    LastRow = SrcWs.Cells(Rows.Count, 265).End(xlUp).Row
    LastCol = SrcWs.Cells(9, Columns.Count).End(xlToLeft).Column
    Range(Cells(10, 1), Cells(LastRow, LastCol)).Copy
    TargetWs.Activate
    eRow = TargetWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).PasteSpecial xlValues
    Cells(9, 1).Select
    
    ' Close Source Workbooks
    Application.DisplayAlerts = False
    SrcWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    FileName = Dir
Loop

'Enable Events
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Select allOpen in new window

• 1. Create a New Folder on your desktop, lets say "Raw Data"
• 2. Download all Raw Data files in a in Newly Created Folder (ZBBModelDE & ZBB-Model-UK)
• 3. Download Master Workbook outside that folder
• 4. Open Master Workbook
• 5. Run Button "Update Travel Sheet".
• 6. It will prompt you to select folder, select the newly created folder.

That's it.
First try on Sample Workbooks attached, then try on your original Workbook.
Kindly note this code works perfectly only for Travel Sheet & I have also noticed in both the sample for Source Data you provided has the same details :)
ZBB-Master-Model-Round-2.xlsm

Thank you both so much!  Mike the code worked like a dream thank you, I have now extended to 11 of the other sheets as they can all be done using the same range as the travel sheet.  All copies across well just need to figure out how to remove the nil value lines and then add a few different data ranges for the remaining few sheets, but will post a new question for this.

Shums thank you so much for providing an alternative, which as you said works perfectly but just for the travel sheet.  As Mike's can extend out to 11 of the 15 sheets I will use that, but as I said to Mike I have a few more tweaks to get to the complete solution, but you have both saved me so much time and I am very very grateful.

Thanks both  Pippa

Thank you both so much for all your help

So sorry to have abandoned the question, rather. Was away for the past week.

Thank you Mike for fixing my somewhat hastily suggested extra code .

Neil, no worries! I only work on questions on here in my "spare time". I'm sure you do the same. We were able to get her an answer that works so it's all good.