Sub findData()
Dim blk As Integer
Dim counter As Long
Dim i As Long
With Sheets("Data")
.Range("H5:J" & .Range("H" & Rows.Count).End(xlUp).Row + 1).ClearContents
blk = .Range("H2").Value
For i = 2 To .Range("D" & Rows.Count).End(xlUp).Row
If .Cells(i, 3) = blk Then
counter = counter + 1
.Range(.Cells(i, 3), .Cells(i, 5)).Copy
.Range("H10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
.Range("I2").Value = counter
If counter = 0 Then MsgBox "No match found.", vbExclamation, "No Match"
Application.CutCopyMode = False
End With
End Sub
Bookmarks