XL 2016 Choisir les onglets à importer d'un fichier fermé

[Geely]

Bonjour à tous

J'ai récupéré cette macro pour importer un onglet d'un classeur fermé. On peut choisir un seul onglet et je souhaiterai selectionner plusieurs onglets et les importer dans mon fichier actif.


merci
Geely

 

[Robert]

Bonjour Geely bonjour le forum,

Attention ! Comme ton fichier est un fichier xls (65536 lignes max) il va buguer si tu tentes d'importer un onglet d'un fichier xlsx ou xlsm (1048576 lignes)... Il te faudra l'enregistrer au format xlsm pour résoudre ce problème...

À l'ouverture, si le fichier contient plus d'uns seul onglet, dans le composant ThisWorkbook je te propose de supprimer les ancien onglets ajoutés. Il faudra veiller à ce que l'onglet qui contient le bourton IMPORTER reste en premier. Si ce code ne te convient pas supprime le...
• Thisworkbook

Private Sub Workbook_Open() 'à l'ouverture du classeur
Dim I As Integer 'déclare la variable I

Worksheets(1).Activate 'activre le premier onglet du classeur
If Sheets.Count > 1 Then 'condition 1 : si le classeur possède plus d'un seul onglet
    If MsgBox("Voulez-vous supprimer les onglets après l'onglet 1 ?", vbYesNo, "SUPPRESSION") = vbYes Then 'condition 2 : si "Oui" au message
        Application.DisplayAlerts = False 'masque les messages d'Excel
        For I = Sheets.Count To 2 Step -1 'boucle inversée du dernier onglet à l'onglet 2
            Worksheets(I).Delete 'efface l'onglet
        Next I 'prochain onglet de la boucle
        Application.DisplayAlerts = True 'affiche les message d'Excel
    End If 'fin de la condition 2
End If 'fin de la condition 1
End Sub

Le bouton IMPORTER lance la procédure Macro1 du module MODULE 1 qui permet de choisir le fichier :

Sub Macro1()
Dim BDO As FileDialog 'déclare la variable BDO (Boite de Dialogue d'Ouverture)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set BDO = Application.FileDialog(msoFileDialogFilePicker) 'définit la boîte de dialogue d'ouverture BDO
BDO.AllowMultiSelect = False 'n'autorise la sélection que d'un seul objet
'si un fichier est s''electionné ouvre le fichier sinon sort de la procédure
If BDO.Show Then Application.Workbooks.Open (BDO.SelectedItems(1)) Else Exit Sub
UserForm1.Show 'affiche l'UserForm1
End Sub

L'Userform1 s'ouvre. Sélectionne le ou les onglets que tu souhaites importer dans le classeur et valide (ou annule). Le code de l'Userform1 :

Private CS As Workbook 'déclare la variable CS (Classeur Source)
Private CD As Workbook 'déclare la variable CD (Classeur Destination)
Private O As Worksheet 'déclare la variable O (Onglet)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Set CS = ActiveWorkbook 'définit le classeur source CS
Set CD = ThisWorkbook 'définit le classeur destination CD
For Each O In CS.Worksheets 'boucle sur tous les onglets O du classeur source CS
    Me.ListBox1.AddItem O.Name 'addtione l'onglet à la ListBox1
Next O 'prochain onglet de la boucle
End Sub

Private Sub CommandButton1_Click() 'bouton "Valider"
For I = 0 To Me.ListBox1.ListCount - 1 'boucle sur tous les éléments de la Listbox1
    If Me.ListBox1.Selected(I) = True Then 'condition : si l'élément est sélectionné
        'copy l'onglet sélectionné du classeur source et le colle en dernière position dans le classeur destinatoion
        CS.Worksheets(Me.ListBox1.List(I)).Copy after:=CD.Worksheets(CD.Sheets.Count)
    End If 'fin de la condition
Next I 'prochaine élément de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
Unload Me 'vide et ferme l'UserForm1
End Sub

Private Sub CommandButton2_Click() 'bouton Annuler
CS.Close False 'ferme le classeur source sans enregistrer
Unload Me 'vide et ferme l'UserForm1
End Sub

Le Fichier :

 

[Geely]

Bonsoir Robert
Merci pour ta réponse et de tous les détails que tu apportes . ça fonctionne.
Merci cela va faire gagner un temps fou.
@+
Geely