Procédure avec Find

Sub Importer()
'Variables utiles à la boucle
Dim Wbk As Workbook 'classeurs
Dim Wsh As Worksheet 'feuilles
'Variables utiles pour déterminer la plage
Dim Dlig As Long 'dernière ligne remplie
'Variables tableau pour le stockage et la restitution des données
Dim Tb(), Indic As Long
'variables numériques pour les boucles sur la variable tableau
Dim i As Long, j As Long

'Effacement des données précédemment recueillies !!!!!!!!!!!!!!!!!!!!!!!
For Each Wsh In ThisWorkbook.Worksheets
  Wsh.Cells.Clear
Next Wsh

'Pour tous les classeurs ouverts dans l'application
For Each Wbk In Application.Workbooks
  'Si le classeur n'est pas le planning général (celui qui contient la macro)
  If Wbk.Name <> ThisWorkbook.Name Then
    'Pour toutes les feuilles de ce classeur (différent de ThisWorkbook)
    For Each Wsh In Wbk.Worksheets
      'Dans la feuille en cours
      With Wsh
        'dernière ligne remplie de la colonne B
        Dlig = .Range("B" & Rows.Count).End(xlUp).Row
        'stockage des données contenues dans les 60 colonnes et x lignes de cette plage
        'Si cellule en B non vide
        For i = 1 To Wsh.Range("B5:B" & Dlig).Cells.Count
          If Wsh.Cells(i + 4, 2) <> "" Then
            Indic = Indic + 1
            ReDim Preserve Tb(1 To 60, 1 To Indic)
            For j = 1 To 60
              Tb(j, Indic) = Wsh.Cells(i + 4, j + 1)
            Next j
          End If
        Next i
      End With
      'Restitution des données dans la feuille du même nom
      With ThisWorkbook.Worksheets(Wsh.Name)
        Dlig = .Range("B" & Rows.Count).End(xlUp).Row + 1
        If Dlig = 2 Then Dlig = 5
        .Range("B" & Dlig).Resize(UBound(Tb, 2), UBound(Tb, 1)) = Application.Transpose(Tb)
      End With
      'Effacement de la variable tableau
      Erase Tb
      Indic = 0
    Next Wsh
  End If
Next Wbk
End Sub

Sub Cherche()
'code pour éviter de voir le défilement de la macro
Application.ScreenUpdating = False
'code pour éviter les alertes de vidange du presse-papier
Application.DisplayAlerts = False
                'code pour effacer les données de toutes les feuilles
                Dim w As Object
                    For Each w In Worksheets
                    Sheets(w.Name).[C5:BJ35].ClearContents
                Next
                
'définition de la variable f
Dim f As Variant
'f = la feuille active
f = ActiveSheet.Index
'calcul du nombre de feuille total du fichier
totalSheets = ActiveWorkbook.Sheets.Count
'f = feuille courante
curentSheet = f
'Set plageC = Application.ActiveWorkbook.ActiveSheet.UsedRange.Columns("A").Cells
'action si la feuille courante est plus petite que le total des feuilles
Do Until curentSheet > totalSheets
'renommer la feuille active
f = curentSheet
'selectionner le classeur et la feuille courante
ActiveWorkbook.Sheets(curentSheet).Select
'avec cette selection
With Selection

                
    'Variables pour trouver les plages de traitement
    Dim Trouve As Range, PlageDeRecherche As Range
    'Variables pour les noms à traiter
    Dim Valeur_Cherchee As String, AdresseTrouvee As String
    Dim i As Range
                'Chercher dans la base de noms
                For Each i In Range("BK1:BK6").Cells
                    'numeroter les noms
                    Valeur_Cherchee = i.Value
                    'ouvrir le classeur exploitation
                    ChDir "G:\2 - EXPLOITATION"
                    Workbooks.Open Filename:="G:\2 - EXPLOITATION\Planning Exploitation.xls"
                    Sheets(f).Select
                    'Selectionner la cellule A1
                    Range("A1").Activate
        'Dans la plage B5:B35
        Set PlageDeRecherche = Range("B5:B35")
        'Chercher le nom et l'appeler trouve
        Set Trouve = PlageDeRecherche.Cells.Find(What:=Valeur_Cherchee, LookAt:=xlWhole)
                    'S'il n'existe pas
                    If Trouve Is Nothing Then
                        'Panneau
                        MsgBox Valeur_Cherchee & " n'est pas présent dans l'onglet " & (f) & " du fichier EXPLOITATION"
                        'Sortir e la procedure
                        Exit Sub
                    'sinon
                    Else
                        ' l'appeler Adressetrouvee
                        AdresseTrouvee = Trouve.Address
                    'fin du si
                    End If
                        'selectionner la cellule
                        Range(AdresseTrouvee).Activate
                        'etendre la selection
                        Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 60).Select
                        'copier
                        Selection.Copy
                        'activer le planning general
                        Windows("Planning General.xls").Activate
                        'Chercher le meme nom que celui copier
                        Range("B5:B35").Find(What:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlWhole).Activate
                        'coller
                         ActiveSheet.Paste
    'fin de i
    Next i
    
End With 'fin du traitement de la feuille
curentSheet = curentSheet + 1 'feuille suivante
Loop 'Fi
                'activer la cellule A1
                Range("A1").Activate
    'Next f
        'Fermer le fichier exploitation
        Windows("Planning Exploitation.xls").Close
'Desactiver la plage de rechche
Set PlageDeRecherche = Nothing
'Desactiver la recherche de "trouve"
Set Trouve = Nothing
'Réactiver les alertes
Application.DisplayAlerts = True
'Reactiver le défilement de la macro
Application.ScreenUpdating = True
'Fin de la macro
End Sub