Copy Row to another Sheet By Value in Column

[trevor2524]

Hello does anybody know how to cut and copy an entire row based on the value found in Column I. It will need to place it in the corresponding sheet based on the value found in Column I. When it gets to the new sheet it will need to find the first available row and paste it. After that it will need to go back to the first sheet and delete the empty row that was just created by the cut and paste and do this until there are no more values found in column A. The Values being looked for in Column I are Newspapers-FL, TV-NY, or Radio-CA. The Sheet names are Newspaper,Radio,TV.Thanks for the help

[SamT]

I am getting a strange error "Too many Characters," so I am breaking my following reply in the middle of the code into two posts.

The first thing to know is that it is best to delete rows from the bottom up, since deleting a row moves the following rows up to fill the space, which messes up the row count.

Therefore it would be best in your case to first copy all the data, then delete all the rows.

You will be dealing with 4 sheet objects, will need to track three "Next Rows" on three of them and need to know how many rows on the main sheet have data.

Compiles OK, but not tested

Option Explicit

Sub Test()

'Declare object references to the worksheets so you don't have to
'waste CPU time by refering to them by name. You will only refer to the
'Main sheet once, so you don't save anything with an Object variable
'for it.
Dim NP, Radio, TV 'As Variants

'Declare Row Trackers
Dim MainLastRow As Long, NPNextRow As Long, RadioNextRow As Long, _
TVNextRow As Long

'Declare a current row index for the Main sheet
Dim r As Long

'Set the Sheet Object references
Set NP = Sheets("Newspaper")
Set Radio = Sheets("Radio")
Set TV = Sheets("TV")

[SamT]

.Cont:

'Set the Row variables.
'Since the these sheets may be empty, you have to test for that.
'I am assuming that the data starts in Row 1. You must modify this
'code to correct that.
'For instance, if you have a column lable above the Data, you can use
'this code construct in all cases:
'NPNextRow = NP.Cells(Rows.Count, "I").End(xlUp).Row + 1'

With NP
If Range("I1") = "" Then
NPNextRow = 1
Else
NPNextRow = .Cells(Rows.Count, "I").End(xlUp).Row + 1
End If
End With
With Radio
If Range("I1") = "" Then
RadioNextRow = 1
Else
RadioNextRow = .Cells(Rows.Count, "I").End(xlUp).Row + 1
End If
End With
With TV
If Range("I1") = "" Then
TVNextRow = 1
Else
TVNextRow = .Cells(Rows.Count, "I").End(xlUp).Row + 1
End If
End With

'Do the Copying. Assuming that the first row of data is r = row 1
'You must replace "MainSheet" with the correct name in all the following code'
With Sheets("MainSheet")
MainLastRow = Sheets("MainSheet").Cells(Rows.Count, "I").End(xlUp).Row

For r = 1 To MainLastRow
Select Case .Cells(r, "I").Value
Case "Newspapers-FL"
Rows(r).Copy NP.Rows(NPNextRow)
NPNextRow = NPNextRow + 1
Case "TV-NY"
Rows(r).Copy TV.Rows(TVNextRow)
TVNextRow = TVNextRow + 1
Case "Radio-CA"
Rows(r).Copy Radio.Rows(RadioNextRow)
RadioNextRow = RadioNextRow + 1
End Select
Next r

'Delete the rows from bottom to top
For r = MainLastRow To 1 Step -1
With .Cells(r, "I")
If .Value = "Newspapers-FL" _
Or .Value = "TV-NY" _
Or .Value = "Radio-CA" _
Then Rows(r).Delete
End With
Next r
End With

End Sub

Note that if you don't need to keep the data rows in order, you can copy from bottom to top and immediately delete the copied row. I leave it to you to experiment how.