Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [H3]) Is Nothing Then
   Dim Sht As Worksheet, Rng As Range, sRng As Range
   Dim DhH As String, MyAdd As String
   Dim Jj As Byte
   
   If [H3].Value = "CN" Then
      Set Sht = Sheets("CA NAM")
   Else
      Set Sht = Sheets(IIf([H3].Value = "KI", "HKI", "HKII"))
   End If
   [B5].CurrentRegion.Offset(1, 1).ClearContents
   Set Rng = Sht.Range(Sht.[Q3], Sht.[Q65500].End(xlUp))
   For Jj = 1 To 2
      DhH = Choose(Jj, "GI", "KH")
      Set sRng = Rng.Find(DhH, , xlValues, xlPart)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            With [B65500].End(xlUp).Offset(1)
               .Value = Sht.Cells(sRng.Row, "B")
               .Offset(, 1).Resize(, 3).Value = sRng.Resize(, 3).Value
            End With
            
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
      Set sRng = Nothing
   Next Jj
 End If
End Sub