Macro to copy data from multiple workbooks into one?

[siperwrx]

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!

 

[siperwrx]

How do you want to handle the formulas? Exclude the row if formulas results are "" (can be based on Column A alone if that's easier)
Do you want to just import values? Yes
Are the columns variable? No
Do you want to paste as values or keep formulas. Paste as Values

 

[NeonRedSharpie]

How do you want to handle the formulas? Exclude the row if formulas results are "" (can be based on Column A alone if that's easier)
Do you want to just import values? Yes
Are the columns variable? No
Do you want to paste as values or keep formulas. Paste as Values

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
    
    With master.Sheets(1).UsedRange
        .Value = .Value
        .Activate
    End With
    
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    
End Sub

This is a bit of a quick hack. I don't know what your formulas reference so I don't know if this will break them or not.

 

[siperwrx]

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
    
    With master.Sheets(1).UsedRange
        .Value = .Value
        .Activate
    End With
    
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    
End Sub

This is a bit of a quick hack. I don't know what your formulas reference so I don't know if this will break them or not.

I changed that last bit to this, but everything else is perfect. Thanks so much for your help!

Dim c As Range
For Each c In Selection
    If c.Value = "" Then c.ClearContents
Next c
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete