EXCEL VBA篩選問題?

Sub TT()

Dim xT, c, x, i
[Z:AF].ClearContents

Set xT = CreateObject("Scripting.Dictionary")
For Each x In [B1:F1]
Set c = x.EntireColumn.Find(x)
If Not c Is Nothing Then
i = 0
firstAddress = c.Address
Do
If c.Row > 1 And Cells(c.Row, 19) <> "" Then
i = i + 1
xT(i) = Cells(c.Row, 19).Resize(, 6)
End If
Set c = Columns(x.Column).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

Set c = Range("Z" & x.Column * 2 - 3)
c.Value = x
c(1, 2).Resize(, 6) = xT(i + (i > 1))
c(2, 2).Resize(, 6) = xT(-i * (i > 1))
Next x

End Sub

檔案無法下載
不太懂篩選條件如果是篩選儲存相同就複製
大概.....
Sub test()
k = 1
For Each c In Range("B2:F22")
If c = Range("B1") Then
Range("B" & c.Row & ":F" & c.Row).Copy Range("AA" & k)
k = k + 1
End If
Next
End Sub