Fusion classeurs "fils" / classeur "père" trop compliquée

Sub test()
Dim nFich As String 'Nom du fichier
Dim Chemin As String 'Chemin
Dim wb As Workbook ' Objet classeur à ouvrir

Chemin = ThisWorkbook.Path

Application.ScreenUpdating = False
Application.DisplayAlerts = False

nFich = Dir(Chemin & "\*.xls") 'Liste des fichiers fils+père
Do While nFich <> "" 'Boucle sur chaque fichier
  nFich = Dir
  If nFich <> ThisWorkbook.Name Then 'Ignorer le fichier père
    Set wb = Workbooks.Open(Chemin & "\" & nFich) 'ouverture

    MsgBox wb.Sheets(1).Range("C3") 'Affichage cellule C3, placer le code qui correspond à ton besoin ici

    wb.Close False 'fermeture
  End If
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

MsgBox wb.Sheets(1).Range("C3") 'Affichage cellule C3, placer le code qui correspond à ton besoin ici

dim c as range
set c=wb.sheets(1).find(what:="N° EV", lookin:=xlvalues, lookat:= xlwhole).offset(1,0) 'c est la cellule sous N° EV dans la feuille 1
do while c<>"" 'Répéter pour chaque cellule en dessous tant que non vides
  if nFich = "Test3.xls" and  instr(c.offset(0,1), "STE") =0 then goto 1 ' si y a pas STE pour le fichier Test3 (adapter le nom...), on le copie pas

  'On peut copier la ligne dans ce classeur (ici en feuille 1 dans un tableau qui débute en colonne A)
  c.entirerow.copy ThisWorkbook.Sheets(1).range("A60000").end(xlup).offset(1,0)
  1: Set c=c.offset(1,0) 'on passe à la ligne suivante
Loop

Sub test()
Dim nFich As String 'Nom du fichier
Dim Chemin As String 'Chemin
Dim wb As Workbook ' Objet classeur à ouvrir

Chemin = ThisWorkbook.Path

Application.ScreenUpdating = False
Application.DisplayAlerts = False

nFich = Dir(Chemin & "\*.xls") 'Liste des fichiers fils+père
Do While nFich <> "" 'Boucle sur chaque fichier
 nFich = Dir
  If nFich <> ThisWorkbook.Name Then 'Ignorer le fichier père
   Set wb = Workbooks.Open(Chemin & "\" & nFich) 'ouverture

    Dim c As Range
Set c = wb.Sheets(1).Find(what:="N° EV", LookIn:=xlValues, lookat:=xlWhole).Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1
Do While c <> "" 'Répéter pour chaque cellule en dessous tant que non vides
 If nFich = "Test3.xls" And InStr(c.Offset(0, 1), "STE") = 0 Then GoTo 1 ' si y a pas STE pour le fichier Test3 (adapter le nom...), on le copie pas

  'On peut copier la ligne dans ce classeur (ici en feuille 1 dans un tableau qui débute en colonne A)
 c.EntireRow.Copy ThisWorkbook.Sheets(1).Range("A60000").End(xlUp).Offset(1, 0)
1:   Set c = c.Offset(1, 0) 'on passe à la ligne suivante
Loop

    wb.Close False 'fermeture
 End If
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Set c = wb.Sheets(1).Find(what:="N° EV", LookIn:=xlValues, lookat:=xlWhole).Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1

Set c = wb.Sheets(1).Range("A12").Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1

Set c = wb.Sheets(1).CELLS.Find(what:="N° EV", LookIn:=xlValues, lookat:=xlWhole).Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1

Sub test()
Dim nFich As String 'Nom du fichier
Dim Chemin As String 'Chemin
Dim wb As Workbook ' Objet classeur à ouvrir
Dim c As Range, d As Range

Chemin = ThisWorkbook.Path

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A6:N1000").Clear
nFich = Dir(Chemin & "\*.xls") 'Liste des fichiers fils+père
nFich = Dir
Do While nFich <> "" 'Boucle sur chaque fichier
  If nFich <> ThisWorkbook.Name Then 'Ignorer le fichier père
   Set wb = Workbooks.Open(Chemin & "\" & nFich) 'ouverture

   Set c = wb.Sheets(1).Range("A1").Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1
   Set d = ThisWorkbook.Sheets(1).Range("A65000").End(xlUp).Offset(1, 0) 'c est la cellule sous N° EV dans la feuille 1
   Do While c <> "" 'Répéter pour chaque cellule en dessous tant que non vides
     If nFich = "Test3.xls" And InStr(c.Offset(0, 1), "STE") = 0 Then GoTo 1 ' si y a pas STE pour le fichier Test3 (adapter le nom...), on le copie pas

     'On peut copier la ligne dans ce classeur (ici en feuille 1 dans un tableau qui débute en colonne A)
     c.Resize(, 2).Copy d
     c.Offset(0, 6).Copy d.Offset(0, 2)
     d.Offset(0, 3) = Split(nFich, ".")(0)
     c.Offset(0, 3).Copy d.Offset(0, 6)
     c.Offset(0, 2).Copy d.Offset(0, 7)
     c.Offset(0, 5).Copy d.Offset(0, 8)
     c.Offset(0, 4).Copy d.Offset(0, 9)
     c.Offset(0, 8).Resize(, 2).Copy d.Offset(0, 11)
     
     Set d = d.Offset(1, 0)
1:   Set c = c.Offset(1, 0) 'on passe à la ligne suivante
Loop

    wb.Close False 'fermeture
 End If
 nFich = Dir
Loop
With ThisWorkbook.Sheets(1)
  .Cells(6, 1).Sort key1:=.Range("A5"), order1:=xlAscending, header:=xlYes
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub