vba - Excel 工作表 - 如果列包含 X，则将 A 列中具有相同单词的行和所有行复制到工作表 2

Question

当前代码将内容从工作表 1 复制到工作表 2，如果 X，从工作表 1 复制到工作表 3，如果 Y。我需要更改它，以便如果 B 列中的一行 = X，它会复制 A 列中具有相同单词的每一行。

Private Sub Worksheet_Activate()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range, r3 As Range, cell As Range
Dim r(1 To 2) As Range
Dim v(1 To 2) As String
Dim shName(1 To 2) As String
Dim i As Long

' see below - current code copies Y rows to sheet 3
v(1) = "X"
v(2) = "Y"
shName(1) = "Sheet2"
shName(2) = "Sheet3"

'If Target.Column = 2 Then

Set sh1 = Worksheets("Sheet1")

For i = LBound(v) To UBound(v)
Set sh2 = Worksheets(shName(i))
Set r3 = sh2.UsedRange.Offset(1, 0)
r3.EntireRow.Delete
Next


Set r1 = sh1.Range("B2", sh1.Cells(sh1.Rows.Count, "B").End(xlUp))
For Each cell In r1
For i = LBound(v) To UBound(v)
  If UCase(cell) = UCase(v(i)) Then
     If r(i) Is Nothing Then
        Set r(i) = cell
     Else
        Set r(i) = Union(r(i), cell)
     End If
     Exit For
  End If
Next
Next


For i = LBound(v) To UBound(v)
 Set sh2 = Worksheets(shName(i))
 If Not r(i) Is Nothing Then
    r(i).EntireRow.Copy sh2.Rows(2)
 End If
Next

'End If

End Sub