Copy and paste same sheet from multiple workbooks to different sheets on master workbook

[Excel_Newbie4980]

Hello Everyone,

Currently, I have a report where I have to copy and paste the same worksheet name "CENTER DATA" from 10 different workbooks into a master workbook. On the master workbook, there are 10 different sheets (One named for each of the individual workbooks). All I need to do is copy the entire worksheet from each individual workbook onto their designated worksheet in the master. Is there a VBA macro that can do this automatically by utilizing a module?

Example for clarity:

Master Workbook
-Sheet 1 (Center 1)
-Sheet 2 (Center 2)
-Sheet 3 (Center 3)
and so on until Center 10.

Each individual workbook: (All workbooks are located in one folder, "C:\Users\maw04\Desktop\AM-PM REPORT
-Workbook 1 (Center 1)
-Workbook 2 (Center 2)
-Workbook 3 (Center 3)
etc...

Each workbook has the same sheet that I am copying and pasting to Master, worksheet "CENTER DATA"

Please help as this is very time consuming!

 

[Excel_Newbie4980]

The code is supposed to be installed in Master workbook in normal module.

I have tested the code with mock up 3 mock-up workbooks with name equal to 3 sheets in Master workbook and it ran just fine. What no clear to me is what you want to copy from each CENTER DATA sheet. My code was just copying whole sheet. Therefore. the whole sheet get replaced each time you run the code. You never mentioned what row or column to copy and how to handle new data coming in.

Right now is bed time for me ? and my sample work is in office. NOt sure what cause the error right now but if I have time during weekend I will try to find the cause.

You have it correct! I am just copying the entire worksheet. I will try it again and see if I have any better luck!

 

[Marc L]

Hi, if it's only to copy entire sheet to the master workbook a VBA demonstration as a beginner starter - not tested as no attachment -​

to paste to the ThisWorkbook module of the master workbook :​

Function ExistsBookSheet(BOOK, SHEET) As Boolean
                       V = Evaluate("ISREF('[" & BOOK & "]" & SHEET & "'!A1)")
         ExistsBookSheet = IIf(IsError(V), False, V)
End Function

Sub Demo1()
    Const C = "CENTER DATA", P = "C:\Users\maw04\Desktop\AM-PM REPORT\"
      Dim F$, N$
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
          F = Dir(P & "*.xls*")
    While F > ""
          N = Left(F, InStrRev(F, ".") - 1)
        With GetObject(P & F)
            If ExistsBookSheet(F, C) Then
                If ExistsBookSheet(Name, N) Then Sheets(N).Delete
               .Sheets(C).Copy(, Sheets(Sheets.Count)).Name = N
            End If
               .Close False
        End With
          F = Dir
    Wend
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

 

[Oddball2020]

There is not currently a list of centers, but I can create one. Each copy/pasted section is exactly the same range size and will never change.

Zot's code is at least 80% along the direction you're looking for. I can do something similar if you wanted to use the workbook open of the CENTER list, plus during each iteration, it'll also use the CENTER 1 etc. text to search for that section on your master sheet in order to paste it in the correct spot. I'll get back to you with an example...

 

[Oddball2020]

It'll appear something like this.... (needs tweaking, but hope it gets you close enough you can manage the rest:

Dim MWkB As Workbook
    Set MWkB = ThisWorkbook   'The master workbook that is running the maco
    
    Dim SourceWB As Workbook   'used later for the source wb's... the CENTER files
        
    Dim myPath As String
    myPath = Application.ThisWorkbook.Path 'the file path for the MWkB

    'Select Folder to Search through that contains the CENTER workbooks
    Dim PickFolder As FileDialog
    Dim CENPath As String   'CENTER path
    
    'Retrieve Target Folder Path From User
    Set PickFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With PickFolder
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        CENPath = .SelectedItems(1) & "\"
    End With
   
   Application.DisplayAlerts = False   'freezes the screen so it won't bounce around... sometimes I like to see it flicker so I know it's doing something
   
    Sheets("CENTER LIST").Activate    'change this sheet name to whatever you put your CENTER list
   
   Dim lastRowCL As Long
    lastRowCL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row     'Change the 1 to reflect the column number where you put your CENTER list; I used column A in this example
   
   Dim i As Long
   Dim CFN As String     'going to use this variable as the CENTER file name
   
   For i = 1 To lastRowCL    'this is the start of the loop, defining how many times (iterations) to loop through
    'Put whatever you want to do each time the loop runs:
    
    'Open the CENTER i file
    CFN = MWkB.Sheets("CENTER LIST").Cells(1, i).Value   'the CENTER name on the list for iteration i
        
    Workbooks.Open (CENPath & "\" & CFN & ".xlsx")  'opens the CENTER i file in the folder you previously selected
    
    Set SourceWB = ActiveWorkbook  'reidentifies the CENTER workbook, which is now active, as SourceWB, for easier future reference
   
    Sheets("CENTER DATA").Activate
   
    'START Check for autofilter in row 1; delete this section if it's not a concern
    With ActiveSheet
    If .AutoFilterMode = True And .FilterMode = True Then   'Autofilter on and columns are filtered (toggle twice to reset filter)
            Rows("1:1").AutoFilter
            Rows("1:1").AutoFilter
        ElseIf .AutoFilterMode = True Then  'Autofilter on but not filtered
        Else        'Autofilter are not on
            Rows("1:1").AutoFilter
    End If
    End With
    'END check
    
    Range(Cells(1, 1), Cells(100, 100)).Copy  'Change the range, in (Rows, Columns) format for what you want to copy; I'd state the range and not use Cells.Copy because you want to paste into a section in your master worksheet, not the entire sheet
     
    MWkB.Sheets("" & CFN & "").Activate
    
    Range("A1").Select    'this needs to be where you want it pasted... if it's not A1 and somewhere else, adjust as needed
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
    SourceWB.Close SaveChanges:=False   'closed that CENTER i file w/o saving
   
   Next i    ' this causes it to go to the next iteration... after the last i, it continues below (exits out of the loop)
   
   'In Case of Cancel
NextCode:
  CENPath = CENPath
  If CENPath = "" Then GoTo ResetSettings
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
    
    'Don't delete this!
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

 

[Excel_Newbie4980]

Oddball,

This is currently what I have pasted in the module. It is still not working correctly...again, I realize it is an error on my part. Any other advice?

Dim MWkB As Workbook
    Set MWkB = ThisWorkbook   'The master workbook that is running the maco
  
    Dim SourceWB As Workbook   'used later for the source wb's... the CENTER files
      
    Dim myPath As String
    myPath = Application.ThisWorkbook.Path 'the file path for the MWkB

    FPath = "C:\Users\maw04\Desktop\AM-PM REPORT"  'Select Folder to Search through that contains the CENTER workbooks
    Dim PickFolder As FileDialog
    Dim CENPath As String   'CENTER path
  
   TPath = "C:\Users\maw04\OneDrive - Service Experts\AM-PM Report\May\Mid Atlantic\5-Mid Atlantic MASTER MAY.xlsm"
    Set PickFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With PickFolder
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        CENPath = .SelectedItems(1) & "\"
    End With
 
   Application.DisplayAlerts = False   'freezes the screen so it won't bounce around... sometimes I like to see it flicker so I know it's doing something
 
    Sheets("Centers").Activate    'change this sheet name to whatever you put your CENTER list
 
   Dim lastRowCL As Long
    lastRowCL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row     'Change the 1 to reflect the column number where you put your CENTER list; I used column A in this example
 
   Dim i As Long
   Dim CFN As String     'going to use this variable as the CENTER file name
 
   For i = 1 To lastRowCL    'this is the start of the loop, defining how many times (iterations) to loop through
    'Put whatever you want to do each time the loop runs:
  
    'Open the CENTER i file
    CFN = MWkB.Sheets("Centers").Cells(1, i).Value   'the CENTER name on the list for iteration i
      
    Workbooks.Open (CENPath & "\" & CFN & ".xlsx")  'opens the CENTER i file in the folder you previously selected
  
    Set SourceWB = ActiveWorkbook  'reidentifies the CENTER workbook, which is now active, as SourceWB, for easier future reference
 
    Sheets("CENTER DATA").Activate
 
    'START Check for autofilter in row 1; delete this section if it's not a concern
    With ActiveSheet
    If .AutoFilterMode = True And .FilterMode = True Then   'Autofilter on and columns are filtered (toggle twice to reset filter)
            Rows("1:1").AutoFilter
            Rows("1:1").AutoFilter
        ElseIf .AutoFilterMode = True Then  'Autofilter on but not filtered
        Else        'Autofilter are not on
            Rows("1:1").AutoFilter
    End If
    End With
    'END check
  
    Range(Cells(1, 1), Cells(43, 27)).Copy  'Change the range, in (Rows, Columns) format for what you want to copy; I'd state the range and not use Cells.Copy because you want to paste into a section in your master worksheet, not the entire sheet
   
    MWkB.Sheets("" & CFN & "").Activate
  
    Range("A1").Select    'this needs to be where you want it pasted... if it's not A1 and somewhere else, adjust as needed
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
    SourceWB.Close SaveChanges:=False   'closed that CENTER i file w/o saving
 
   Next i    ' this causes it to go to the next iteration... after the last i, it continues below (exits out of the loop)
 
   'In Case of Cancel
NextCode:
  CENPath = CENPath
  If CENPath = "" Then GoTo ResetSettings

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
    'Don't delete this!
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

 

[Oddball2020]

Oddball,

This is currently what I have pasted in the module. It is still not working correctly...again, I realize it is an error on my part. Any other advice?

Dim MWkB As Workbook
    Set MWkB = ThisWorkbook   'The master workbook that is running the maco
 
    Dim SourceWB As Workbook   'used later for the source wb's... the CENTER files
     
    Dim myPath As String
    myPath = Application.ThisWorkbook.Path 'the file path for the MWkB

    FPath = "C:\Users\maw04\Desktop\AM-PM REPORT"  'Select Folder to Search through that contains the CENTER workbooks
    Dim PickFolder As FileDialog
    Dim CENPath As String   'CENTER path
 
   TPath = "C:\Users\maw04\OneDrive - Service Experts\AM-PM Report\May\Mid Atlantic\5-Mid Atlantic MASTER MAY.xlsm"
    Set PickFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With PickFolder
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        CENPath = .SelectedItems(1) & "\"
    End With

   Application.DisplayAlerts = False   'freezes the screen so it won't bounce around... sometimes I like to see it flicker so I know it's doing something

    Sheets("Centers").Activate    'change this sheet name to whatever you put your CENTER list

   Dim lastRowCL As Long
    lastRowCL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row     'Change the 1 to reflect the column number where you put your CENTER list; I used column A in this example

   Dim i As Long
   Dim CFN As String     'going to use this variable as the CENTER file name

   For i = 1 To lastRowCL    'this is the start of the loop, defining how many times (iterations) to loop through
    'Put whatever you want to do each time the loop runs:
 
    'Open the CENTER i file
    CFN = MWkB.Sheets("Centers").Cells(1, i).Value   'the CENTER name on the list for iteration i
     
    Workbooks.Open (CENPath & "\" & CFN & ".xlsx")  'opens the CENTER i file in the folder you previously selected
 
    Set SourceWB = ActiveWorkbook  'reidentifies the CENTER workbook, which is now active, as SourceWB, for easier future reference

    Sheets("CENTER DATA").Activate

    'START Check for autofilter in row 1; delete this section if it's not a concern
    With ActiveSheet
    If .AutoFilterMode = True And .FilterMode = True Then   'Autofilter on and columns are filtered (toggle twice to reset filter)
            Rows("1:1").AutoFilter
            Rows("1:1").AutoFilter
        ElseIf .AutoFilterMode = True Then  'Autofilter on but not filtered
        Else        'Autofilter are not on
            Rows("1:1").AutoFilter
    End If
    End With
    'END check
 
    Range(Cells(1, 1), Cells(43, 27)).Copy  'Change the range, in (Rows, Columns) format for what you want to copy; I'd state the range and not use Cells.Copy because you want to paste into a section in your master worksheet, not the entire sheet
  
    MWkB.Sheets("" & CFN & "").Activate
 
    Range("A1").Select    'this needs to be where you want it pasted... if it's not A1 and somewhere else, adjust as needed
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    SourceWB.Close SaveChanges:=False   'closed that CENTER i file w/o saving

   Next i    ' this causes it to go to the next iteration... after the last i, it continues below (exits out of the loop)

   'In Case of Cancel
NextCode:
  CENPath = CENPath
  If CENPath = "" Then GoTo ResetSettings

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
 
    'Don't delete this!
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

Which part it it throwing errors on? Run it, when it gives you an error box, hit debug then copy/paste in the forum the highlighted yellow section, thanks. It'll do that a few times as we work through it to correct everything.

 

[Excel_Newbie4980]

Which part it it throwing errors on? Run it, when it gives you an error box, hit debug then copy/paste in the forum the highlighted yellow section, thanks. It'll do that a few times as we work through it to correct everything.

Currently, it is giving me error code: "Compile error: Invalid outside procedure."

 

[Oddball2020]

Currently, it is giving me error code: "Compile error: Invalid outside procedure."

Hit DEBUG and copy/paste the highlighted yellow line of code. That first error box message doesn't say anything by itself.

 

[Excel_Newbie4980]

I did...see uploaded image for what pops up.

 

[Oddball2020]

Nevermind, I set it up on my end and figured it out. Had a couple of typos, try this:

Dim MWkB As Workbook
    Set MWkB = ThisWorkbook   'The master workbook that is running the maco
  
    Dim SourceWB As Workbook   'used later for the source wb's... the CENTER files
      
    Dim myPath As String
    myPath = Application.ThisWorkbook.Path 'the file path for the MWkB

    FPath = "C:\Users\maw04\Desktop\AM-PM REPORT"  'Select Folder to Search through that contains the CENTER workbooks
    Dim PickFolder As FileDialog
    Dim CENPath As String   'CENTER path
  
   TPath = "C:\Users\maw04\OneDrive - Service Experts\AM-PM Report\May\Mid Atlantic\5-Mid Atlantic MASTER MAY.xlsm"
    Set PickFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With PickFolder
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        CENPath = .SelectedItems(1) '& "\"
    End With
        
   Application.DisplayAlerts = False   'freezes the screen so it won't bounce around... sometimes I like to see it flicker so I know it's doing something
 
    Sheets("Centers").Activate    'change this sheet name to whatever you put your CENTER list
 
   Dim lastRowCL As Long
    lastRowCL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row     'Change the 1 to reflect the column number where you put your CENTER list; I used column A in this example
 
   Dim i As Long
   Dim CFN As String     'going to use this variable as the CENTER file name
 
   For i = 1 To lastRowCL    'this is the start of the loop, defining how many times (iterations) to loop through
    'Put whatever you want to do each time the loop runs:
  
    'Open the CENTER i file
    CFN = MWkB.Sheets("Centers").Cells(i, 1).Value   'the CENTER name on the list for iteration i
       
    Workbooks.Open (CENPath & "\" & CFN & ".xlsx")  'opens the CENTER i file in the folder you previously selected
  
    Set SourceWB = ActiveWorkbook  'reidentifies the CENTER workbook, which is now active, as SourceWB, for easier future reference
 
    Sheets("CENTER DATA").Activate
 
    'START Check for autofilter in row 1; delete this section if it's not a concern
    With ActiveSheet
    If .AutoFilterMode = True And .FilterMode = True Then   'Autofilter on and columns are filtered (toggle twice to reset filter)
            Rows("1:1").AutoFilter
            Rows("1:1").AutoFilter
        ElseIf .AutoFilterMode = True Then  'Autofilter on but not filtered
        Else        'Autofilter are not on
            Rows("1:1").AutoFilter
    End If
    End With
    'END check
  
    Range(Cells(1, 1), Cells(43, 27)).Copy  'Change the range, in (Rows, Columns) format for what you want to copy; I'd state the range and not use Cells.Copy because you want to paste into a section in your master worksheet, not the entire sheet
   
    MWkB.Sheets("" & CFN & "").Activate
  
    Range("A1").Select    'this needs to be where you want it pasted... if it's not A1 and somewhere else, adjust as needed
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
    SourceWB.Close SaveChanges:=False   'closed that CENTER i file w/o saving
 
   Next i    ' this causes it to go to the next iteration... after the last i, it continues below (exits out of the loop)
 
   'In Case of Cancel
NextCode:
  CENPath = CENPath
  If CENPath = "" Then GoTo ResetSettings

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
    'Don't delete this!
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True