Give this try.
Sub abc()
Const sh1 As String = "sheet1"
Const sh2 As String = "sheet2"
Dim rng As Range, c As Range, FoundCell As Range
With Worksheets(sh2).Range("a1")
With .CurrentRegion
.AutoFilter Field:=8, Criteria1:="Data"
Set rng = .SpecialCells(xlCellTypeVisible)
End With
.AutoFilter
End With
With Worksheets(sh1)
For Each c In rng.Rows
If Not rng(c.Row, "f") = vbNullString Then
Set FoundCell = .Range("f:f").Find(What:=rng(c.Row, "f"))
If Not FoundCell Is Nothing Then
c.EntireRow.Copy .Cells(FoundCell.Row, "a")
End If
End If
Next
End With
Set rng = Nothing
Set FoundCell = Nothing
Set c = Nothing
End Sub
Bookmarks