Copy To Next Blank Row

November 20, 2001 - by Bill Jelen

NYARCH writes

I want to have Excel copy an entire row to a new Excel worksheet based upon a cell entry. For example I have data in cells A8:AG8, I want to have Excel copy the entire row to sheet "a" if the value in H8 is "ir", and sheet "b" if the value in H8 is "RR". The most complicated part and not just copied, I need it copied to the next blank row on the worksheet. Of the 150 rows or so only about 15 of each type will actually be copied to a new sheet.

MrExcel will award 50 bonus points to any reader who remembers the Lotus Magazine article offering 10 great tips, where tip #4 was "Use the End key to Move to the End of a Range". Going back to the days of Lotus, you could put the cellpointer anywhere in a block of data, hit END then down, and the cell pointer would ride to the end of the range. Excel has similar functionality, VBA has similar functionality, and this is the key to finding the last row of data on a sheet.

The VBA technique is to use End(xlDown) to simulate the End+Down key or End(xlUp) to simulate the End+Up key. Pressing this key sequence will move the cell pointer to the next edge of a contiguous range of data. Imagine there are values in A1:A10 and A20:A30. Start in A1. Hit End+Down and the cell pointer moves to A10. Hit End+Down and you go to A20, which is the top edge of the next contiguous range of data. Hit End+Down and you will go to A30. I am actually at a loss how to explain this behavior in simple English. Just try it and you will see how it works.

The trick that I use is to start at Column A in the last row in the spreadsheet and then hit End+Up. This will take me to the final row with data. I then know to use the next row down as a blank row.

Here is a brute-force macro to solve this week's problem. Yes, you could certainly do this more elegantly with an AutoFilter. The data currently is on Sheet1, with headings in row 2.

Public Sub CopyRows()
    Sheets("Sheet1").Select
    ' Find the last row of data
    FinalRow = Range("A65536").End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column H
        ThisValue = Range("H" & x).Value
        If ThisValue = "ir" Then
            Range("A" & x & ":AG" & x).Copy
            Sheets("a").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            ActiveSheet.Paste
            Sheets("Sheet1").Select
        ElseIf ThisValue = "RR" Then
            Range("A" & x & ":AG" & x).Copy
            Sheets("b").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            ActiveSheet.Paste
            Sheets("Sheet1").Select
        End If
    Next x
End Sub

Given that Excel 2007 has more than 65,536 rows, you could use this macro so it is forward compatible. Note that I use CELLS(Row, Column) instead of RANGE here:

Public Sub CopyRows()
    Sheets("Sheet1").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column H
        ThisValue = Cells(x, 8).Value
        If ThisValue = "ir" Then
            Cells(x, 1).Resize(1, 33).Copy
            Sheets("a").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet1").Select
        ElseIf ThisValue = "RR" Then
            Cells(x, 1).Resize(1, 33).Copy
            Sheets("b").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet1").Select
        End If
    Next x
End Sub

For tips on how to use a macro, see Introducing the Excel VBA Editor.