Macro VBA userform copier des données de plusieurs feuilles dans autre classeur

[Shyro]

Bonjour,

J'ai une macro dans un classeur qui ouvre une boite de dialogue, pour parcourir et selection d'un classeur excel. Une fois le classeur choisi, j'ai un userform pour le choix de la feuille. Quand j'appuie sur le bouton, une macro copie une certaine plage de cellules dans cette feuille et les copie dans le classeur contenant la macro.

Tout ça fonctionne trés bien. Sauf que j'aimerai pouvoir selectionner plusieurs feuilles dans le userform et les données de chaque feuilles choisies seraient récupérées et collées. Je précise que toutes feuilles cibles ont la même mise en forme, donc la plage désirée est fixe. J'ai un multiselect quelque part dans le code et j'ai essayé des heures de manipuler tout ça sans succés.

Au niveau macro, j'ai un userform avec ces codes:

Private Sub CommandButton1_Click()
Dim i As Integer
UserForm1.Hide
With ListBox1
  For i = 0 To .ListCount - 1
    If .Selected(i) Then Sheets(.List(i)).Activate
    Next
 End With
UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()
Dim s As Object
ListBox1.MultiSelect = fmMultiSelectExtended
For Each s In Sheets
  ListBox1.AddItem s.Name
Next
End Sub

Ensuite dans ma macro "principale" j'ai un truc comme ça (moquez vous pas s'il vous plaît c'est vraiment du bricolage d'amateur):

Option Explicit

Sub Copier()
Application.ScreenUpdating = False

Dim Fichier As Variant
Dim x As Integer
Dim monchoix As String

Fichier = Application.GetOpenFilename
If Fichier = False Then Exit Sub
Workbooks.Open Filename:=Fichier
Fichier = Dir(Fichier)

x = Worksheets.Count
If (x <> 1) Then
UserForm1.Show
End If
   
Range("A2:I65535").Copy

Application.DisplayAlerts = False

Windows("Essai Recap Total 2").Activate
Range("A" & Range("A65535").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
        
     Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Transactions").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Transactions").Sort.SortFields.Add Key:=Range( _
        "F2:F65535"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Transactions").Sort
        .SetRange Range("F1:F65535")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Du coup ça marche pas et les données d'une seule feuille sont copiées...
Quelqu'un aurait-il une solution? Une idée peut-être de la bonne méthode?
Intuitivement je pensais à une sorte de boucle qui récupère les données de chaque feuille sélectionnée et les colle ensuite mais bon...

Merci d'avance