Copy/Paste macro if data exists

[jcrizzy]

Hi all,

Was wondering if someone has/could provide a macro to copy and paste data from one spreadsheet to another if there is data. This is what I'm trying to do.

I have a workbook (We'll call this A) with one worksheet (we'll call it 1) that takes data from another workbook (we'll call this B) with three worksheets (we'll call this 1, 2, 3). Currently, I am just pasting in the values manually from B123 into A1 to consolidate. The columns headings and stuff are all the same in workbook B so it is literally just a simple copy and paste. So literally, I just paste from B1 to A1, then B2 to the end of A1, B3 to the end of A1.

If I wanted, I could just link the two workbooks together but the amount of rows in workbook B changes every day so I need a little more intelligence to do this. So i need the macro to simply check if there isn't any data left in the next row, stop pasting and go to the next worksheet and repeat.
Thanks.

 

[Warship]

Try this:

Sub ConsolidateBintoA()
    Dim wbA As Workbook, wbB As Workbook
    Dim sh As Worksheet, Btbl As Range
    Dim LastRowA As Long
    Set wbA = ThisWorkbook
    Set wbB = Workbooks("BookB.xlsx") ' change BookB.xlsx to your workbook name
    For Each sh In wbB.Sheets
        LastRowA = wbA.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        Set Btbl = sh.Cells(1, 1).CurrentRegion
        Set Btbl = Btbl.Offset(1, 0).Resize(Btbl.Rows.Count - 1, Btbl.Columns.Count)
        Btbl.Copy wbA.Sheets("Sheet1").Cells(LastRowA + 1, 1)
    Next sh
End Sub