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

Bobstar

New Member
Joined
Oct 7, 2020
Messages
14
Office Version
  1. 2019
Platform
  1. Windows
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.
 

Attachments

  • Master file.PNG
    Master file.PNG
    108.2 KB · Views: 12

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

Check below code:

VBA 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

New Member
Joined
Oct 7, 2020
Messages
14
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Check below code:

VBA 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

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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")

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

Bobstar

New Member
Joined
Oct 7, 2020
Messages
14
Office Version
  1. 2019
Platform
  1. Windows
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")

VBA Code:
         .Range("A5:M6").copy
        destWB.Sheets("info").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Thanks alot. This is working as expected.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,957
Messages
5,621,822
Members
415,859
Latest member
Vain

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