Find a value, copy the row, move to next row.

I need to search for a value in column "J" in "sheet1" then copy the data that is in that row from Column a to k into sheet2. Currently I have the following that copies the whole row:

 Sub copyrows()
     
    Dim tfCol As Range, Cell As Object
     
    Set tfCol = Range("j2:j3200")
     
    For Each Cell In tfCol
         
        If IsEmpty(Cell) Then
            Exit Sub
        End If
         
        If Cell.Value = "Startup" Then
            Cell.EntireRow.Copy
            Sheets("Startup").Select
            ActiveSheet.Range("A3200").End(xlUp).Select
            Selection.Offset(1, 0).Select
            ActiveSheet.Paste
        End If
         
    Next
     
End Sub

I need to only copy and paste Column "a" through "k" and to move to the next row down after it fills the value. Help?

 Sub copyrows()
     
    Dim tfCol As Range, Cell As Object
     
    Set tfCol = Range("j2:j3200")
     
    For Each Cell In tfCol
         
        If IsEmpty(Cell) Then
            Exit Sub
        End If
         
        If Cell.Value = "Startup" Then
            Cell.Offset(, -9).Resize(, 11).Copy
            Sheets("Startup").Select
            ActiveSheet.Range("A3200").End(xlUp).Select
            Selection.Offset(1, 0).Select
            ActiveSheet.Paste
        End If
         
    Next
     
End Sub

Thanks AB33 that defiantly helps (and works)...any idea how to get it to paste each result to a new row? For example when you run this macro row 2 is copied, then row 7 on top of it, then row 10 on top and so on. I want the macro to start at the top and do this:
Find first row in column J that is "startup->copy to the other sheet->find the next value in J->copy it to the next blank row and so on

Originally Posted by AB33

 Sub copyrows()
     
    Dim tfCol As Range, Cell As Object
     
    Set tfCol = Range("j2:j3200")
     
    For Each Cell In tfCol
         
        If IsEmpty(Cell) Then
            Exit Sub
        End If
         
        If Cell.Value = "Startup" Then
            Cell.Offset(, -9).Resize(, 11).Copy
            Sheets("Startup").Select
            ActiveSheet.Range("A3200").End(xlUp).Select
            Selection.Offset(1, 0).Select
            ActiveSheet.Paste
        End If
         
    Next
     
End Sub

Sub copyrows()
     
    Dim tfCol As Range, Cell As Object
     
    Set tfCol = Range("j2:j" & Cells(Rows.Count, "J").End(xlUp).Row)
     
    For Each Cell In tfCol
         
        If IsEmpty(Cell) Then
            Exit Sub
        End If
         
        If Cell.Value = "Startup" Then
            Cell.Offset(, -9).Resize(, 11).Copy
            Sheets("Startup").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
           
        End If
         
    Next
     
End Sub

It jumps back and forth between sheets but is only overwritting the data into a2:k2

Originally Posted by AB33

Sub copyrows()
     
    Dim tfCol As Range, Cell As Object
     
    Set tfCol = Range("j2:j" & Cells(Rows.Count, "J").End(xlUp).Row)
     
    For Each Cell In tfCol
         
        If IsEmpty(Cell) Then
            Exit Sub
        End If
         
        If Cell.Value = "Startup" Then
            Cell.Offset(, -9).Resize(, 11).Copy
            Sheets("Startup").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
           
        End If
         
    Next
     
End Sub

This is better code

Sub test()
Dim i&, LR&
With ActiveSheet
  LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
  For i = 2 To LR
   If Len(.Cells(i, 10)) Then
        If Trim(.Cells(i, 10)) = "Startup" Then
        .Cells(i, 1).Resize(, 11).Copy
         Sheets("Startup").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        End If
     End If
  Next i
 End With
End Sub

No, it should not be.
You should be on the active and have a sheet called Startup and run the code.

Please do not reply with quote

I think there is a flaw in your code

  If IsEmpty(Cell) Then
            Exit Sub

As soon as the code finds blank cell in column,J, it is terminated, so It will not go in to next cell as you might have expected

Sorry about that. Tried the new code and it is doing the same thing i.e. not putting each instance of "startup" in a new row on the new sheet

"startup" in a new row on the new sheet .
Do you want to create a new sheet for each startup"? Please post your sample book

I had to remove data from Column a,b,c as it is confidential

Okay!
If you are copying to column A and that column first row is blank, the code will keep overwriting all the subsequent cells in to it because VBA treats the next empty cell which is column A.
The easiest way would be to include the same heading on the start sheet in row 1, so that the next empty row would be 2 and so on.

Or if you wan to copy staring in column B as your data format shows, you can use line

Sheets("Startup").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues

Lately, I am learning on overcoming my phobia with filter and a have a loop fatigue

Sub Converted()
    Dim LR&
    Application.ScreenUpdating = False
    With Sheets("Main")
        LR = .Range("J" & Rows.Count).End(xlUp).Row
        .Range("A1:K" & LR).AutoFilter 10, "Startup"
        .Range("A1:K" & LR).Copy
        Sheets("Startup").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        Application.CutCopyMode = True
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

Yep "A" was blank in some. Fixed the problem. Last code is super fast too. THanks