VBA Lister certaines colonnes seulement

Sub Chercher()
 
    Dim FeConsult As Worksheet
    Dim FeBase As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String
    Dim I As Long
 
    'défini les variables feuille
    Set FeConsult = Worksheets("Consultation")
    Set FeBase = Worksheets("Base")
 
    'défini la plage de recherche en feuille "Base" sur la
    'colonne B à partir de la 2ème ligne(à adapter)
    With FeBase
        Set Plage = .Range(.[B2], .Range("B" & Rows.Count).End(xlUp))
    End With
 
    'efface toutes les valeurs à partir de la ligne 7
    'puisque valeur cherchée est en B6 (à adapter aussi)
    With FeConsult
        .Range(.Cells(7, 1), .Cells(Rows.Count, 1)).EntireRow.ClearContents
    End With
 
    'recherche toutes les correspondances exactes
    Set Cel = Plage.Find(FeConsult.[B6], , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        Adr = Cel.Address
        I = 6 'commence à partir de la ligne 7
 
        Do
            I = I + 1
            'copie la ligne entière
            'Cel.EntireRow.Copy FeConsult.Range("A" & I)
            
            'copie cellule(s) B en B: a adapter
            Cel.Copy FeConsult.Range("B" & I)
            'copie cellule(s) C en C: a adapter
            Cel.Offset(, 1).Copy FeConsult.Range("C" & I)
 
            Set Cel = Plage.FindNext(Cel)
 
        Loop While Adr <> Cel.Address
 
    End If
 
End Sub