Importer x onglets de y classeurs dans une nouvelle feuille

Bonsoir,
J'ai besoin de votre aide pour réaliser une macro capable de:
1-Importer tous les onglets visibles de plusieurs classeurs provenant d'un même dossier pour simplifier :) ( sinon éventuellement si possible une boite de dialogue me demandant de sélectionner les classeurs dans différents fichiers)
2-Les onglets et le nombre de lignes sont variables d'un classeur à l'autre, les onglets ont des entêtes identiques mais ne commencent pas forcement à la même ligne (l'idée est de commencer l'importation après l'entête de colonne "affaires" et à partir de "en cours", et de copier les contenus de tous les onglets les uns en dessous des autres après avoir précisé la direction de production).
'Si possible une boite de dialogue qui simplifierait ça (je ne sais pas comment).
3-Supprimer ensuite les lignes vide pour avoir un fichier bien propre, et surtout ne rien modifier aux classeurs sources (aucune demande d'enregistrement ou de messages inutiles).

J'ai un code qui marche bien pour des classeurs simples avec une seule feuille (même configuration sur chaque feuille et les données empilées les unes en dessous des autres sans espace), j'aimerais que vous m'aidiez à l'adapter svp.
Je voudrai mettre en pièce jointe un fichier exemple, mais je ne trouve pas cette option.

Sub Transferer()
Dim dossier As Object, Fichier As Object
Dim Chemin As String
Dim Derlg As Integer
Dim c As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = True

Derlg = Range("A65536").End(xlUp).Row + 1
Range("A2:N" & Derlg).Clear

Chemin = ThisWorkbook.Path
           FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

For Each Fichier In dossier.Files
    
NomFichier = Fichier.Name
If Not Fichier.Name = "Recap.xls" Then

Derlg = Range("A65536").End(xlUp).Row + 1

Workbooks.Open Filename:=Chemin & "/" & NomFichier

On Error Resume Next
        
With Workbooks(NomFichier)
.Sheets("Feuil1").Range("A2:N" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Sheets("Feuil1").Range("A" & Derlg)
.Close
End With

End If
Next

End Sub

Merci d'avance pour votre aide .