VBA copying data from a master file to multiple workbooks and worksheets

[Bobstar]

Hello

I am looking for help with a VBA code that copies data from a master file to multiple workbooks and worksheets. I can only find a code that does the opposite i.e. copy data from multiple workbooks to a master file.

The Masterfile will contain 12 worksheets named p1, p2,…p12. Focusing on one worksheet, say p1, I would like the data in this worksheet to be copied to a workbook that is named p1_data.xlsx.

The workbook, p1_data.xlsx (where data is to be copied to) has 4 worksheets and I would like data to be copied to it from the Masterfile (p1 worksheet) in the following manner:

• Copy cells A5:M6 (from the master file) to info tab
• Copy cells O5:R26 (from the master file) to projected returns worksheet/tab
• Copy cells T5: AB10 (from the master file) to returnlikelihood worksheet/tab
• Copy cells AD5: AI16 (from the master file) to assetallocation worksheet/tab

My thinking is that the macro should open the workbook (for example p1_data.xlsx), copy data from the Masterfile (p1 worksheet) as per above, save, close, then open the next workbook (p2_data.xlsx) and copy the data from the masterfile (p2 worksheet). The macro should repeat the process 12 times.

If it helps, all the workbooks will be saved in one folder and I have attached an image of the masterfile data for p1 (data to be copied to the p1_data.xlsx workbook).

Any help is much appreciated.

 

[Saurabhj]

Hi,

Check below code:

Sub copyToMultipleSheets()
'On Error Resume Next
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim sheetnum As Integer
Application.ScreenUpdating = False
Set sourceWB = ThisWorkbook
For sheetnum = 1 To sourceWB.Worksheets.Count
    Set destWB = Workbooks.Open(sourceWB.Path & "\" & sourceWB.Worksheets(sheetnum).Name & "_data.xlsx")
    
    With sourceWB.Sheets(sourceWB.Worksheets(sheetnum).Name)
        .Range("A5:M6").copy Destination:=destWB.Sheets("info").Range("A1")
        .Range("O5:R26").copy Destination:=destWB.Sheets("projected returns").Range("A1")
        .Range("T5: AB10").copy Destination:=destWB.Sheets("returnlikelihood").Range("A1")
        .Range("AD5: AI16").copy Destination:=destWB.Sheets("assetallocation").Range("A1")
    End With
    Application.CutCopyMode = False
    destWB.Save
    destWB.Close
Next
Application.ScreenUpdating = True
End Sub

 

[Bobstar]

Hi,

Check below code:

Sub copyToMultipleSheets()
'On Error Resume Next
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim sheetnum As Integer
Application.ScreenUpdating = False
Set sourceWB = ThisWorkbook
For sheetnum = 1 To sourceWB.Worksheets.Count
    Set destWB = Workbooks.Open(sourceWB.Path & "\" & sourceWB.Worksheets(sheetnum).Name & "_data.xlsx")
   
    With sourceWB.Sheets(sourceWB.Worksheets(sheetnum).Name)
        .Range("A5:M6").copy Destination:=destWB.Sheets("info").Range("A1")
        .Range("O5:R26").copy Destination:=destWB.Sheets("projected returns").Range("A1")
        .Range("T5: AB10").copy Destination:=destWB.Sheets("returnlikelihood").Range("A1")
        .Range("AD5: AI16").copy Destination:=destWB.Sheets("assetallocation").Range("A1")
    End With
    Application.CutCopyMode = False
    destWB.Save
    destWB.Close
Next
Application.ScreenUpdating = True
End Sub

Thank you very much. This seems to do the job. A few follow up comments:

• I would like to copy the data as values (the data will have formulas) but maintain the number formatting for example percentages, dates etc.
• Could we speed the macro perhaps using assignment rather than copy destinaton?

Once again thanks alot.

 

[Saurabhj]

Hi, to copy the data as values and to maintain number formatting, use below instead of .Range("A5:M6").copy Destination:=destWB.Sheets("info").Range("A1")

         .Range("A5:M6").copy
        destWB.Sheets("info").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

 

[Bobstar]

Hi, to copy the data as values and to maintain number formatting, use below instead of .Range("A5:M6").copy Destination:=destWB.Sheets("info").Range("A1")

         .Range("A5:M6").copy
        destWB.Sheets("info").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Thanks alot. This is working as expected.

 

[Saurabhj]

Great. Thanks for the feedback.