Sub TaoSoCai()
Dim r As Long, i As Long, FirstAddress As String
Dim Rng As Range, FoundCell As Range
Application.ScreenUpdating = False
Rows("14:1000").EntireRow.Hidden = False
[A14:G41].ClearContents
With Sheets("NKC")
r = .[A65536].End(xlUp).Row
Set Rng = .Range("F11:G" & r)
Set FoundCell = Rng.Find(what:=[D8] & "*", after:=.[F11], LookIn:=xlValues, _
LookAt:=xlWhole, searchorder:=xlByRows)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
i = 14
Do
Cells(i, 1).Resize(, 4) = .Cells(FoundCell.Row, 1).Resize(, 4).Value
Select Case FoundCell.Column
Case 6
Cells(i, 5) = FoundCell.Offset(, 1).Value
Cells(i, 6) = FoundCell.Offset(, 2).Value
Case 7
Cells(i, 5) = FoundCell.Offset(, -1).Value
Cells(i, 7) = FoundCell.Offset(, 2).Value
End Select
i = i + 1
Set FoundCell = Rng.FindNext(FoundCell)
Loop While FirstAddress <> FoundCell.Address
End If
If i > 14 Then Rows(i & ":1000").EntireRow.Hidden = True
End With
Set Rng = Nothing: Set FoundCell = Nothing
Application.ScreenUpdating = True
End Sub