Copy Data to First Blank Row Using VBA

[jmischel]

Here is my task:

I have many worksheets (30 or more) called Product1, Product2, Product3, etc. The number of worksheets is constantly increasing. For each worksheet, I need to look in column B starting at row 5 and find the last row with data in it, then copy the data in columns A-K, rows 5 through the last row.

I will then consolidate that data in a worksheet called Orders. I will copy the data into the Orders worksheet by looking in Column B starting at row 5 and paste into the first empty row using columns A:K. I will then repeat that process for each Product worksheet.

Thanks for any help provided.

Jason

 

[Randall00]

Sub InefficientAsHell Macro
 
    Sheets("Product1").Select
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
 
    Sheets("ORDERS").Select
    Range("A5").Select
 
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
 
    ActiveSheet.Paste
 
    Sheets("Product2").Select
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
 
    Sheets("ORDERS").Select
    Range("A5").Select
 
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
 
    ActiveSheet.Paste
 
End Sub

....and so on for Product3, etc.

Am I close...?

 

[Weaver]

Try this on a copy of your data

Sub collate()
    Dim firstRow As Double, lastRow As Double, destRng As Range, ws As Worksheet
    firstRow = 5
    For Each ws In Sheets
        'goes through the workbook grabbing data, if the sheet isn't called "orders"
        With ws
            If .Name <> "orders" Then
                'finds last used row by selecting last row and simulating ctrl-up arrow
                lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                'gets range of first cell on row below data already on sheet
                Set destRng = Sheets("orders").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1)
                .Range(.Cells(firstRow, "A"), .Cells(lastRow, "K")).Copy Destination:=destRng
            End If
        End With
    Next ws
End Sub

It's worth pointing out that if there are any other sheets besides "orders" you don't want to copy data from, the IF statement will have to be modified accordingly.

 

[jmischel]

Weaver,

Thanks for code. It worked very well but I need one modification. I need to paste only values and not formulas but I can't figure out the syntax with the "Destination" command. Can you help me out?

Thanks,
Jason

Try this on a copy of your data

Sub collate()
    Dim firstRow As Double, lastRow As Double, destRng As Range, ws As Worksheet
    firstRow = 5
    For Each ws In Sheets
        'goes through the workbook grabbing data, if the sheet isn't called "orders"
        With ws
            If .Name <> "orders" Then
                'finds last used row by selecting last row and simulating ctrl-up arrow
                lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                'gets range of first cell on row below data already on sheet
                Set destRng = Sheets("orders").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1)
                .Range(.Cells(firstRow, "A"), .Cells(lastRow, "K")).Copy Destination:=destRng
            End If
        End With
    Next ws
End Sub

It's worth pointing out that if there are any other sheets besides "orders" you don't want to copy data from, the IF statement will have to be modified accordingly.

 

[Weaver]

I'm doing this from work, so it's not tested - be careful!

            If .Name <> "orders" Then
                'finds last used row by selecting last row and simulating ctrl-up arrow
                lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                'gets range of first cell on row below data already on sheet
                set destRng = Sheets("orders").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1).resize(lastrow-firstrow+1,11)
                destRng.value=.Range(.Cells(firstRow, "A"), .Cells(lastRow, "K")).value
            End If

 

[jmischel]

Weaver,

I get an overflow error with this code at the line starting destRng.Value

Jason

I'm doing this from work, so it's not tested - be careful!

            If .Name <> "orders" Then
                'finds last used row by selecting last row and simulating ctrl-up arrow
                lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                'gets range of first cell on row below data already on sheet
                set destRng = Sheets("orders").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1).resize(lastrow-firstrow+1,11)
                destRng.value=.Range(.Cells(firstRow, "A"), .Cells(lastRow, "K")).value
            End If

 

[Weaver]

I've had chance to look at this properly now.

I'm guessing you have to do the resize before the offset.

Either way, it's tested.

Sub collate2()
    Dim firstRow As Double, lastRow As Double, srcRng As Range, destRng As Range, ws As Worksheet
    firstRow = 5
    For Each ws In Sheets
        'goes through the workbook grabbing data, if the sheet isn't called "orders"
        With ws
            If LCase(.Name) <> "orders" Then
                'finds last used row by selecting last row and simulating ctrl-up arrow
                lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                If lastRow >= firstRow Then 'makes sure there's some data to copy
                    'gets range of data in current sheet
                    Set srcRng = .Range(.Cells(firstRow, "A"), .Cells(lastRow, "K"))
                    'gets range of first cell on row below data already on sheet
                    Set destRng = Sheets("orders").Cells(Rows.Count, "B").End(xlUp).Resize(lastRow - firstRow + 1, 11).Offset(1, -1)
                    destRng.Value = srcRng.Value
                End If
            End If
        End With
    Next ws
End Sub

Again, note my comment about other sheets besides 'orders' which may not be part of the collation process.

 

[jmischel]

This macro has worked well for me. However, I have now added a new worksheet called "Sheet4" to this spreadsheet. I also want its data excluded from the macro. This line in the macro needs to be modified:

If LCase(.Name) <> "orders" Then

It needs to not equal "orders" and "Sheet4" but I'm unsure of the syntax to use.

Thanks.