if in worksheet "test1" is in cell G2 to G1000 an entry"share sale" copy the row new sheet

Hi all,

in worksheet "test1" I insert new forms. I use cell a to g.
If in cell G2 to G1000 is an entry "share sale" I have to copy the complete line A to G
in another worksheet with the Name "Sale"Žin to the next free line.

Have anybody an idea how to write this VBA?

Kind regards,

Thorsten

Maybe:

Sub torti111()
Dim i As Long, y
With Sheets("test1")
    ReDim y(2 To 1000)
    For i = LBound(y) To UBound(y)
        If .Cells(i, "G") = "share sale" Then
            .Range(.Cells(i, "A"), .Cells(i, "G")).Copy Sheets("Sale").Range("A" & Rows.Count).End(3)(2)
        End If
    Next i
End With
End Sub

Hi, that is fine. One Question: What I have to add if the copied lines have to be deleted in the sheet "test1"?

Kind regards,
Thorsten

Try:

Sub torti111()
Dim i As Long, y
With Sheets("test1")
    ReDim y(2 To 1000)
    For i = LBound(y) To UBound(y)
        If .Cells(i, "G") = "share sale" Then
            .Range(.Cells(i, "A"), .Cells(i, "G")).Copy Sheets("Sale").Range("A" & Rows.Count).End(3)(2)
        End If
    Next i
    .Range(.Cells(1, "G"), .Cells(1000, "G")).AutoFilter 1, "share sale"
    .Range(.Cells(2, "G"), .Cells(1000, "G")).SpecialCells(12).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

Thank you. It works fine.

You're welcome. Glad to help out and thanks for the feedback.

Hi John,
I made 6 different Codes (Sale, Enroll, Change, Stop, Restart, Cancellation) and they work fine.
The only thing is if I have for example no "Change" in sheet "test1" and run the code, I get an error message "No cells were found"
I think this happens in the line with the "Auto filter".
Is there any chance that the code don't run the Auto filter and search for lines to delete if "Change" not exists?

Kind regards, Thorsten

Try:

Sub torti111()
Dim i As Long, y
With Sheets("test1")
    ReDim y(2 To 1000)
    For i = LBound(y) To UBound(y)
        If .Cells(i, "G") = "share sale" Then
            .Range(.Cells(i, "A"), .Cells(i, "G")).Copy Sheets("Sale").Range("A" & Rows.Count).End(3)(2)
        End If
    Next i
    .Range(.Cells(1, "G"), .Cells(1000, "G")).AutoFilter 1, "share sale"
    On Error Resume Next
    .Range(.Cells(2, "G"), .Cells(1000, "G")).SpecialCells(12).EntireRow.Delete
    On Error GoTo 0
    .AutoFilterMode = False
End With
End Sub

Perfect. This is very helpful and a good training for me. Last Question: If i would like to select two different "keywords", for example "share sale" and "cancellation". Is it very complicated?

No, try:

Sub torti111()
Dim i As Long, y
With Sheets("test1")
    ReDim y(2 To 1000)
    For i = LBound(y) To UBound(y)
        Select Case .Cells(i, "G")
            Case Is = "share sale", "cancellation"
            .Range(.Cells(i, "A"), .Cells(i, "G")).Copy Sheets("Sale").Range("A" & Rows.Count).End(3)(2)
        End Select
    Next i
    .Range(.Cells(1, "G"), .Cells(1000, "G")).AutoFilter 1, "share sale", xlAnd, "cancellation"
    On Error Resume Next
    .Range(.Cells(2, "G"), .Cells(1000, "G")).SpecialCells(12).EntireRow.Delete
    On Error GoTo 0
    .AutoFilterMode = False
End With
End Sub

Perfect. Thank you very much. Great help.
Kind regards, Thorsten

Again welcome and glad to help out.