CODEWITHSUNDEEP
excelvba
user3587469
user3587469

Reputation: 3

VBA Cut & Paste row by multiple criteria

I'm trying to write VBA code to cut/copy paste rows in one worksheet to a new worksheet as long as column H contains any of the values I dictate.

The current code I have works when I only set one value, but I would like the code to execute as long as any of the values I dictate are in the cell. Please advise, thanks.

Sub CutPastebyAM()

Dim sht1 As Worksheet, sht2 As Worksheet
Dim i As Long

Set sht1 = ThisWorkbook.Worksheets("Data")
Set sht2 = ThisWorkbook.Worksheets("Sheet1")

For i = 2 To sht1.Cells(sht1.Rows.Count, "H").End(xlUp).Row
    If sht1.Range("H" & i).Value = "Laine Sikula" Or "Kim Gotti" Then
        sht1.Range("A" & i).EntireRow.Cut sht2.Range("A" & sht2.Cells(sht2.Rows.Count, "H").End(xlUp).Row + 1)
    End If
Next i

End Sub

Upvotes: 0

Views: 343

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

Almost there:

EDIT - copying to different sheets

Sub CutPastebyAM()

    Dim sht1 As Worksheet
    Dim i As Long, v, SheetName

    Set sht1 = ThisWorkbook.Worksheets("Data")

    For i = 2 To sht1.Cells(sht1.Rows.Count, "H").End(xlUp).Row

        Select Case sht1.Range("H" & i).Value
            Case "Laine Sikula": SheetName = "Sheet1"
            Case "Kim Gotti": SheetName = "Sheet2"
            Case Else: SheetName = ""
        End Select

        If Len(SheetName) > 0 Then
            With Sheets(SheetName)
                sht1.Range("A" & i).EntireRow.Cut _
                   .Range("A" & .Cells(.Rows.Count, "H").End(xlUp).Row + 1)
            End With
        End If
    Next i

End Sub

Upvotes: 1

Related Questions