Macro to copy data from multiple workbooks into one?

S

siperwrx

New Member
Joined
Mar 14, 2014
Messages
15
Hey there,
I'm looking for something somewhat complex but I'm hoping there's an expert out there who can help me. I have one master workbook that I use to manage multiple ad campaigns. I'm trying to pull data from multiple workbooks into this master workbook based upon certain criteria.

Let's say I have these workbooks:
Master Workbook
Campaign A
Campaign B
Campaign C

Here's how I need it to function:
Copy all rows with data from Campaign A's Sheet1 to Master Workbook.
Then
Check Campaign B's Sheet1 and copy all rows with data, paste BELOW Campaign A's data on Master Workbook
Then
Check Campaign C's Sheet1 and copy all rows with data, paste BELOW Campaign B's data on Master Workbook

I'm sorry I can't upload an example (I work for a data-sensitive company). Any help would be greatly appreciated!
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
Code: 
Sub copyWorkbooks()

    Dim master As Workbook
    Dim campA As Workbook
    Dim campB As Workbook
    Dim campC As Workbook
    
    Dim nextRow As Long
    
    Set master = Workbooks("Master Workbook.xlsx")
    Set campA = Workbooks("Campaign A.xlsx")
    Set campB = Workbooks("Campaign B.xlsx")
    Set campC = Workbooks("Campaign C.xlsx")
    
    'Comment this out if you don't want to clear existing values
    master.Sheets(1).UsedRange.Clear
    'Comment this out if you don't want to clear existing values
    
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Activate
    campA.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campB.Activate
    campB.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campC.Activate
    campC.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
End Sub
 
Upvote 0
NeonRedSharpie said:
Code: 
Sub copyWorkbooks()

    Dim master As Workbook
    Dim campA As Workbook
    Dim campB As Workbook
    Dim campC As Workbook
    
    Dim nextRow As Long
    
    Set master = Workbooks("Master Workbook.xlsx")
    Set campA = Workbooks("Campaign A.xlsx")
    Set campB = Workbooks("Campaign B.xlsx")
    Set campC = Workbooks("Campaign C.xlsx")
    
    'Comment this out if you don't want to clear existing values
    master.Sheets(1).UsedRange.Clear
    'Comment this out if you don't want to clear existing values
    
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Activate
    campA.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campB.Activate
    campB.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campC.Activate
    campC.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
End Sub
Click to expand...

This looks great! One more thing: how do I make it so the file paths for each campaign is based on another cell?
Code: 
    Set campA = Workbooks("Cell reference on Master!A1")
    Set campB = Workbooks("Cell reference on Master!A2")
    Set campC = Workbooks("Cell reference on Master!A3")

Sorry for the dumb question, I'm new.
 
Upvote 0
This actually doesn't open any of the workbooks, it assumes they are open already. But, in order to use a cell reference to locate a workbook:

Code: 
With master.sheets(1)
    Set campA = Workbooks(.Range("A1") & ".xlsx")
    Set campB = Workbooks(.Range("B1") & ".xlsx")
    Set campC = Workbooks(.Range("C1") & ".xlsx")
End With
 
Upvote 0
Sorry, I should have specified--it needs to pull data from closed workbooks. Is that possible?
 
Upvote 0
I can make it open them and then close them. So sure. This uses sheet2 in master, cells A1:A3. You can change that if need be.

Code: 
Sub copyWorkbooks()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With


    Dim master As Workbook
    Dim campA As Workbook
    Dim campB As Workbook
    Dim campC As Workbook
    
    Dim nextRow As Long
    
    Set master = Workbooks("Master Workbook.xlsx")
    
    With master.Sheets(2)
        
        Workbooks.Open .Cells(1, 1).Value
        Set campA = ActiveWorkbook
        
        Workbooks.Open .Cells(2, 1).Value
        Set campB = ActiveWorkbook
        
        Workbooks.Open .Cells(3, 1).Value
        Set campC = ActiveWorkbook


    End With
        
    'Comment this out if you don't want to clear existing values
    master.Sheets(1).UsedRange.Clear
    'Comment this out if you don't want to clear existing values
    
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Activate
    campA.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Close
    
    campB.Activate
    campB.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campB.Close
    
    campC.Activate
    campC.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campC.Close
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
End Sub
 
Upvote 0
NeonRedSharpie said:
I can make it open them and then close them. So sure. This uses sheet2 in master, cells A1:A3. You can change that if need be.

Code: 
Sub copyWorkbooks()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With


    Dim master As Workbook
    Dim campA As Workbook
    Dim campB As Workbook
    Dim campC As Workbook
    
    Dim nextRow As Long
    
    Set master = Workbooks("Master Workbook.xlsx")
    
    With master.Sheets(2)
        
        Workbooks.Open .Cells(1, 1).Value
        Set campA = ActiveWorkbook
        
        Workbooks.Open .Cells(2, 1).Value
        Set campB = ActiveWorkbook
        
        Workbooks.Open .Cells(3, 1).Value
        Set campC = ActiveWorkbook


    End With
        
    'Comment this out if you don't want to clear existing values
    master.Sheets(1).UsedRange.Clear
    'Comment this out if you don't want to clear existing values
    
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Activate
    campA.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Close
    
    campB.Activate
    campB.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campB.Close
    
    campC.Activate
    campC.Sheets(1).UsedRange.Copy
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campC.Close
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
End Sub
Click to expand...

This worked great!
Last questions:
1. It's copying cells that have formulas in them, but they are really blank. How do I exclude those?
2. How do I have it start copying at A3 in each workbook instead of everything? (It's copying my title row with it)
 
Upvote 0
I tried to cheat...I was hoping I could cheat...I wanted to be able to cheat...

Ok, here's a couple questions:

How do you want to handle the formulas? Do you want to just import values?
Are the columns variable? I should just go ahead and make a range...fine...I'll just make a range. So I guess it's just do you want to paste as values or keep formulas. I'm not sure how I'd exclude blank formulas.
 
Upvote 0
NeonRedSharpie said:
I tried to cheat...I was hoping I could cheat...I wanted to be able to cheat...

Ok, here's a couple questions:

How do you want to handle the formulas? Do you want to just import values?
Are the columns variable? I should just go ahead and make a range...fine...I'll just make a range. So I guess it's just do you want to paste as values or keep formulas. I'm not sure how I'd exclude blank formulas.
Click to expand...


Sorry if I've bothered you. I'm new to all this and I'm just trying to get something functional before a deadline. I really do appreciate your help though.
 
Upvote 0
You're fine, none of this is really that difficult. I just always take the path of least resistance rather than actually using real coding practice because it's faster and easier to troubleshoot.

So how do you want to handle blank formulas?

Below looks at the used range, starting at A3.

Code: 
Sub copyWorkbooks()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With




    Dim master As Workbook
    Dim campA As Workbook
    Dim campB As Workbook
    Dim campC As Workbook
    
    Dim maxRow As Long
    Dim maxCol As Integer
    
    Dim nextRow As Long
    
    Set master = Workbooks("Master Workbook.xlsx")
    
    With master.Sheets(2)
        
        Workbooks.Open .Cells(1, 1).Value
        Set campA = ActiveWorkbook
        
        Workbooks.Open .Cells(2, 1).Value
        Set campB = ActiveWorkbook
        
        Workbooks.Open .Cells(3, 1).Value
        Set campC = ActiveWorkbook


    End With
        
    'Comment this out if you don't want to clear existing values
    master.Sheets(1).UsedRange.Clear
    'Comment this out if you don't want to clear existing values
    
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    With campA.Sheets(1)
        .Activate
        maxRow = .Cells(Rows.Count, "A").End(xlUp).Row
        maxCol = .Cells(3, Columns.Count).End(xlToLeft).Column
        .Range(.Cells(3, 1), .Cells(maxRow, maxCol)).Copy
    End With


    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campA.Close
    
    With campB.Sheets(1)
        .Activate
        maxRow = .Cells(Rows.Count, "A").End(xlUp).Row
        maxCol = .Cells(3, Columns.Count).End(xlToLeft).Column
        .Range(.Cells(3, 1), .Cells(maxRow, maxCol)).Copy
    End With
    
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campB.Close
    
    With campC.Sheets(1)
        .Activate
        maxRow = .Cells(Rows.Count, "A").End(xlUp).Row
        maxCol = .Cells(3, Columns.Count).End(xlToLeft).Column
        .Range(.Cells(3, 1), .Cells(maxRow, maxCol)).Copy
    End With
    
    master.Activate
    master.Sheets(1).Cells(nextRow, 1).Select
    ActiveSheet.Paste
    nextRow = master.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    campC.Close
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Copy to Multiple Worksheets With Different Arranged Headers ROW by ROW
Replies
1
Views
78
Cubist
Cubist
K
  • Question
Help with VB Code to copy workbook
Replies
0
Views
199
kizzie37
K
K
  • Question
vba copying unique values of a range to another workbook.
Replies
1
Views
51
k_bs
K
C
  • Solved
Index Matching + Data ranges inside a MINIFS()
Replies
3
Views
779
Alex Blakenburg
A
P
  • Question
VBA issue. runtime 91 - only occurring after change to Range?
Replies
6
Views
235
PTEOMARK
P

Forum statistics

Threads
1,215,493
Messages
6,125,119
Members
449,206
Latest member
burgsrus

Share this page

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
Back
Top