Enregistrer onglets vers nouveaux fichiers si sélectionné dans listboxx

Bonsoir le forum

En pièce jointe j'ai déposé un fichier contenant un "UserForm".

Avec celui-ci je cherche à sélectionner différents onglets d'un même fichier

et les enregistrer en nouveaux fichiers excel dans un dossier de mon choix.

Mon souci c'est d'imbriquer deux codes, celui qui permet de sélectionner les onglets

et celui qui va me permettre des les exporter vers de nouveaux fichiers

Petit plus, svp, comment ôter de la liste du "listbox2" les feuilles "INDEX" et "CAP-FT-v2"

D'avance je vous remercie pour votre aide et pour votre disponibilité

Bonnes vacances à ceux qui peuvent en prendre et courage pour les autres

Merci

Bonjour,

voici un exemple à adapter,

Private Sub CommandButton1_Click()
Dim I As Integer
Dim wk1 As Workbook, wk2 As Workbook
Dim Chemin As String

Set wk1 = ThisWorkbook
Set wk2 = Workbooks.Add(xlWBATWorksheet)

Chemin = ThisWorkbook.Path  ' à adapter

With Me.ListBox2
    For I = 0 To .ListCount - 1
        If .Selected(I) = True And .List(I) <> "INDEX" And .List(I) <> "Fiche Appui" Then
           wk1.Sheets(.List(I)).Copy After:=wk2.Worksheets(wk2.Worksheets.Count)
        End If
    Next I
End With

With wk2
    Application.DisplayAlerts = False
    .Sheets(1).Delete
    .SaveAs Filename:=Chemin & "\" & "blabla", FileFormat:=xlOpenXMLWorkbook   '"blabla" ---> Feuille.Name??
    .Close
    Application.DisplayAlerts = True
End With

wk1.Activate
End Sub

Bonjour Le Forum

Bonjour Isabelle

Merci pour ta disponibilité et pour ton aide

L'exemple que tu me propose m'intéresse, mais ce que je cherche à faire, c'est de créer autant de fichiers Excel que d'onglets sélectionnés et de nommer ces fichiers avec leur nom d'onglet.

eole-33 a écrit :

mais ce que je cherche à faire, c'est de créer autant de fichiers Excel que d'onglets sélectionnés et de nommer ces fichiers avec leur nom d'onglet.

ok,

à tester,

Private Sub CommandButton1_Click()
Dim I As Integer
Dim wk1 As Workbook
Dim Chemin As String

Set wk1 = ThisWorkbook

Chemin = ThisWorkbook.Path  ' à adapter

With Me.ListBox2
    For I = 0 To .ListCount - 1
        If .Selected(I) = True And .List(I) <> "INDEX" And .List(I) <> "Fiche Appui" Then
            wk1.Sheets(.List(I)).Copy
            With ActiveWorkbook
              .SaveAs Filename:=Chemin & "\" & .List(I), FileFormat:=xlOpenXMLWorkbook
              .Close
            End With
        End If
    Next I
End With

wk1.Activate
End Sub

Merci Isabelle

mais j'ai un souci avec ce bout de code:

.SaveAs Filename:=Chemin & "\" & .List(I), FileFormat:=xlOpenXMLWorkbook

à l'enregistrement du premier onglet j' ai :

"Erreur d'exécution '438':

Propriété ou méthode non gérée par cet objet"

re,

il faudrait vérifier la valeur des variables, Chemin & "\" & .List(I)

Bonsoir le forum

Bonsoir Isabelle

Pour la variable "chemin "j'ai le bon chemin c'est à dire l'emplacement où se trouve mon fichier

Pour la valeur "list" j'ai toujours "2" que je coche 1, 2, 3 ... choix

Je re dépose le fichier si besoin. J'ai placé le code dans le commande "CommandButton3" pour le tester seul et dans le "CommandButton1" "envoyer vers dossiers"

Merci pour ta dispo et pou ton aide

re,

nouvelle version,

à tester,

Private Sub CommandButton1_Click()
Dim I As Integer
Dim wk1 As Workbook
Dim Chemin As String

Set wk1 = ThisWorkbook

Chemin = ThisWorkbook.Path  ' à adapter

With Me.ListBox2
    For I = 0 To .ListCount - 1
        If .Selected(I) = True And .List(I) <> "INDEX" And .List(I) <> "Fiche Appui" Then
            wk1.Sheets(.List(I)).Copy
            With ActiveWorkbook
              .SaveAs Filename:=Chemin & "\" & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbook
              .Close
            End With
        End If
    Next I
End With

wk1.Activate
End Sub

Ok super Isabelle

un grand merci pour ton aide et ta disponibilité

Merci pour ce retour, au plaisir!