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