VBA剪切和粘贴行按多个条件

时间:2018-12-07 18:46:06

标签: excel vba excel-vba

我试图编写VBA代码,以将一个工作表中的粘贴行剪切/复制到新工作表中,只要H列包含我指定的任何值即可。

当我仅设置一个值时,我拥有的当前代码有效,但是只要我指定的任何值在单元格中,我都希望代码能够执行。请告知,谢谢。

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

1 个答案:

答案 0 :(得分:0)

几乎在那里:

编辑-复制到其他工作表

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