Copy Data to First Blank Row Using VBA

jmischel

New Member
Joined
Apr 8, 2008
Messages
30
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Code:
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...?
 
Upvote 0
Try this on a copy of your data

Code:
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.
 
Upvote 0
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

Code:
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.
 
Upvote 0
I'm doing this from work, so it's not tested - be careful!

Code:
            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
 
Upvote 0
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!

Code:
            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
 
Upvote 0
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.

Code:
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

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