Mettre un ensemble de classeur sur un seul document

Sub Menu1()

dim j as integer
j=0
 
While encore=true

'Copie du 1ER classeur
 On Error Resume Next
 ChDir ThisWorkbook.Path
 'Workbooks.Open Filename:=Application.GetOpenFilename("Excel Files (*.xls),*.xls")
 Application.DisplayAlerts = False
 If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub 'Permet d'ouvrir un classeur dont je ne connais pas le nom
 Dim Wbk As Workbook
 Set Wbk = ActiveWorkbook
 Dim Feuille As Worksheet
 Dim AA() As String
 Dim i As Integer
 i = 0
 For Each Feuille In Wbk.Sheets

'je ne comprends pas l'utilisation de AA(i)

' ReDim Preserve AA(i)
' AA(i) = Feuille.Name
' Wbk.Sheets(AA(i)).Select

Wbk.Sheets(Feuille).Select 'ou Feuille.Select 'je ne sais plus lequel marche

dim k as integer

k=50*i+j

 Range("A1:B50").Copy
 Workbooks("Classeur1.xlsm").Worksheets("feuil1").R ange("A" & k + 1).PasteSpecial Paste:=xlPasteAll 'modifié
 Next Feuille
 Wbk.Close savechanges:=False
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
' Worksheets("feul1").Range("AA1") = 1 / c'est là que je bloque, je voudrais mettre que si AA1 = 1 alors copier sur A51 à B101, puis si AA1 = 2 mettre sur A102:B152 etc...' retiré car plus besoin


Response = MsgBox("un autre classeur", vbYesNo, "encore ?")
If Response = vbYes Then    ' L'utilisateur a choisi Oui.
    encore = true
Else    ' L'utilisateur a choisi Non.
    encore = false
End If

j=k+50
wend

 End Sub

For Each Feuille In Wbk.Sheets
ReDim Preserve AA(i)
AA(i) = Feuille.Name
Wbk.Sheets(AA(i)).Select
Range("A1:B50").Copy
Workbooks("Classeur1.xlsm").Worksheets("feuil1").R ange("A1").PasteSpecial Paste:=xlPasteAll
Next Feuille

With Workbooks("Classeur1.xlsm").Worksheets("feuil1")
For Each Feuille In Wbk.Sheets 
    DerL=.Range("A" & .Rows.Count).End(xlUp).Row+1
    Wbk.Sheets(Feuille.Name)Range("A1:B50").Copy  .Range("A" & DerL)
Next Feuille
End With

Sub Menu1()
'Copie des classeurs

 Application.ScreenUpdating = false
 Application.DisplayAlerts = False
 Dim Wbk As Workbook
 Set Wbk = ThisWorkbook ' le classeur qu lance la macro et qui reçoit les copies
 Dim Feuille As Worksheet
 Dim i As Integer

 Chemin = Wbk.Path & "\"   ' à adapter .Définit le chemin d'accès aux fichiers.
 NomFic = Dir(Chemin & "*.xls*")    ' prend le premier fichier parmi les fichiers xls,xlsx,xlsm ...

 Do While NomFic <> ""    ' Commence la boucle.
    Workbooks.Open Filename:=Chemin & NomFic

    With Wbk.Worksheets("feuil1")
    For Each Feuille In ActiveWorkbook.Worksheets
        DerL=.Range("A" & .Rows.Count).End(xlUp).Row+1
        Feuille.Range("A1:B50").Copy  .Range("A" & DerL) 'pas sûr que ça marche
    Next Feuille
    End With

   Workbooks(NomFic).Close savechanges:=False

   NomFic = Dir    ' prend le fichier suivant 
 Loop

 Application.DisplayAlerts = True
 Application.ScreenUpdating = True

End Sub