Déplacer des feuilles d'un classeur à un autre avec Listbox

Le 13/04/2016 à 14:00

Bonjour à tous!

Je suis nouveau sur le forum et j'ai un soucis ( je suis débutant en excel).

Dans un UserForm, je sélectionne les feuilles que je souhaite déplacer. En cliquant sur un bouton CREER, je voudrais déplacer les feuilles d'un classeur, vers un nouveau classeur...

J'ai pour l'instant ce code:

Private Sub CommandButton_Create_Click()

For I = 0 To ListBox_Specific_IF.ListCount - 1

Sheets(ListBox_Specific_IF.List(I)).Visible = 1

'On créer l'objet Excel

Set xlApp = CreateObject("Excel.Application")

'On ajoute un classeur

Set xlBook = xlApp.Workbooks.Add

'On rend le classeur visible

xlApp.Visible = True

Sheets(ListBox_Specific_IF.List(I)).Move Before:=Workbooks("Classeur1").Sheets(1)

Next

UserForm_IF.Hide

End Sub

Ce code ne marche pas . Pouvez vous m'aider svp ? ça fait un bon moment que je galère sur ce sujet. Merci à vous !

Le 13/04/2016 à 15:12

Bonjour Doola, bonjour le forum,

Peut-être comme ça :

Private Sub CommandButton_Create_Click()
Dim TOS() As String 'déclare la variable TOS (Tableau des OngletS)
Dim CO As Workbook 'déclare la variable CO (Classeur d'Origine)

Set CO = ThisWorkbook 'définit la classeur CO
For I = 0 To ListBox_Specific_IF.ListCount - 1 'boucle sur tous les éléments de la listBox "ListBox_Specific_IF"
    If ListBox_Specific_IF.Selected(I) = True Then 'condition : si l'élément est sélectionné
        ReDim Preserve TOS(J) 'redimensionne la tableau des onglets TOS
        TOS(J) = ListBox_Specific_IF.List(I) 'ajoute la valeur de l'élément sélectionné au tableau TOS
        J = J + 1 'incrémente I
    End If 'fin d ela condition
Next I 'prohcain élément de la boucle
On Error GoTo fin 'en cas d'erreur va à l'étiquette "fin"
Sheets(TOS).Copy 'crée un fichier avec les onglets du tableau des onglets TOS (génère une erreur si le tableau des onglet est vide)
Application.DisplayAlerts = False 'masque les messages d'Excel
For I = 0 To UBound(TOS, 1) 'boucle sur tous les onglets du tableau des onglets TOS
    CO.Sheets(TOS(I)).Delete 'supprime l'onglet dans le classeur d'Origine
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'excel
fin: 'étiquette
UserForm_IF.Hide 'vide et ferme l'UserForm
End Sub
Le 13/04/2016 à 15:36
ThauThème a écrit :

Bonjour Doola, bonjour le forum,

Peut-être comme ça :

Private Sub CommandButton_Create_Click()
Dim TOS() As String 'déclare la variable TOS (Tableau des OngletS)
Dim CO As Workbook 'déclare la variable CO (Classeur d'Origine)

Set CO = ThisWorkbook 'définit la classeur CO
For I = 0 To ListBox_Specific_IF.ListCount - 1 'boucle sur tous les éléments de la listBox "ListBox_Specific_IF"
    If ListBox_Specific_IF.Selected(I) = True Then 'condition : si l'élément est sélectionné
        ReDim Preserve TOS(J) 'redimensionne la tableau des onglets TOS
        TOS(J) = ListBox_Specific_IF.List(I) 'ajoute la valeur de l'élément sélectionné au tableau TOS
        J = J + 1 'incrémente I
    End If 'fin d ela condition
Next I 'prohcain élément de la boucle
On Error GoTo fin 'en cas d'erreur va à l'étiquette "fin"
Sheets(TOS).Copy 'crée un fichier avec les onglets du tableau des onglets TOS (génère une erreur si le tableau des onglet est vide)
Application.DisplayAlerts = False 'masque les messages d'Excel
For I = 0 To UBound(TOS, 1) 'boucle sur tous les onglets du tableau des onglets TOS
    CO.Sheets(TOS(I)).Delete 'supprime l'onglet dans le classeur d'Origine
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'excel
fin: 'étiquette
UserForm_IF.Hide 'vide et ferme l'UserForm
End Sub

C'est super Sympas d'avoir répondu, merci pour votre aide !!!

Le problème est que lorsque je lance votre programme, je n'ai pas de nouveau classeur contenant les onglets de la ListBox.

Comment cela se fait il ?

En fait lorsque j'appuies sur le bouton créer, rien ne se passe.

Le 13/04/2016 à 16:45

Re,

Puisqu'il est question d'une ListBox, le code proposé ne copie que éléments sélectionnés de celle-ci. Il faut donc commencer par sélectionner dans la liste les onglets que tu désires déplacer dans le nouveau classeur. Ils seront alors supprimés de ton classeur original et déplacés dans un nouveau classeur qu'il te faudra ensuite sauver...

Mais si tu veux déplacer tous les onglets de la listbox il faudra juste modifier un peu le code. Sachant que ton classeur original doit garder un onglet au minimum...

Le 13/04/2016 à 17:04
ThauThème a écrit :

Re,

Puisqu'il est question d'une ListBox, le code proposé ne copie que éléments sélectionnés de celle-ci. Il faut donc commencer par sélectionner dans la liste les onglets que tu désires déplacer dans le nouveau classeur. Ils seront alors supprimés de ton classeur original et déplacés dans un nouveau classeur qu'il te faudra ensuite sauver...

Mais si tu veux déplacer tous les onglets de la listbox il faudra juste modifier un peu le code. Sachant que ton classeur original doit garder un onglet au minimum...

En fait, les IF_SPECIFIC proviennent déja d'une autre listBox ALL_IF. Après avoir appuyé sur un bouton " ajouter", les IF passent de la première listbox ALL_IF vers la seconde listbox IF_SPECIFIC

Ensuite c'est justement les éléments contenus dans la list_box IF_SPECIFIC( qui sont en fait des feuilles), que je souhaiterai copier vers un autre classeur, qui viendrait s'ouvrir automatiquement.

Voici donc le programme que j'ai réalisé, peut être que ça vous aidera à mieux comprendre mon problème :

Private Sub CommandButton_Add_All_Click()

For I = 0 To ListBox_All_IF.ListCount - 1

ListBox_Specific_IF.AddItem ListBox_All_IF.List(I)

Next

ListBox_All_IF.Clear

End Sub

Private Sub CommandButton_Add_One_Click()

If ListBox_All_IF.ListIndex <> -1 Then

ListBox_Specific_IF.AddItem ListBox_All_IF.Value

ListBox_All_IF.RemoveItem ListBox_All_IF.ListIndex

Else

MsgBox "Vous devez sélectionner qqch"

End If

End Sub

Private Sub CommandButton_Cancel_Click()

UserForm_IF.Hide

End Sub

Private Sub CommandButton_Create_Click()

For I = 0 To ListBox_Specific_IF.ListCount - 1

Sheets(ListBox_Specific_IF.List(I)).Visible = 1

Next

UserForm_IF.Hide 'vide et ferme l'UserForm

End Sub

Private Sub CommandButton_Delete_All_Click()

For I = 0 To ListBox_Specific_IF.ListCount - 1

ListBox_All_IF.AddItem ListBox_Specific_IF.List(I)

Next

ListBox_Specific_IF.Clear

End Sub

Private Sub CommandButton_Delete_One_Click()

If ListBox_Specific_IF.ListIndex <> -1 Then

ListBox_All_IF.AddItem ListBox_Specific_IF.Value

ListBox_Specific_IF.RemoveItem ListBox_Specific_IF.ListIndex

Else

MsgBox "Vous devez sélectionner qqch"

End If

End Sub

Merci pour votre réponse.

Le 13/04/2016 à 17:07

Re,

Il suffit juste de supprimer la condition. Cela donne :

Private Sub CommandButton_Create_Click()
Dim TOS() As String 'déclare la variable TOS (Tableau des OngletS)
Dim CO As Workbook 'déclare la variable CO (Classeur d'Origine)

Set CO = ThisWorkbook 'définit la classeur CO
For I = 0 To ListBox_Specific_IF.ListCount - 1 'boucle sur tous les éléments de la listBox "ListBox_Specific_IF"
    ReDim Preserve TOS(J) 'redimensionne la tableau des onglets TOS
    TOS(J) = ListBox_Specific_IF.List(I) 'ajoute la valeur de l'élément sélectionné au tableau TOS
    J = J + 1 'incrémente I
Next I 'prohcain élément de la boucle
On Error GoTo fin 'en cas d'erreur va à l'étiquette "fin"
Sheets(TOS).Copy 'crée un fichier avec les onglets du tableau des onglets TOS (génère une erreur si le tableau des onglet est vide)
Application.DisplayAlerts = False 'masque les messages d'Excel
For I = 0 To UBound(TOS, 1) 'boucle sur tous les onglets du tableau des onglets TOS
   CO.Sheets(TOS(I)).Delete 'supprime l'onglet dans le classeur d'Origine
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'excel
fin: 'étiquette
UserForm_IF.Hide 'vide et ferme l'UserForm
End Sub

Je me demande pourquoi je me casse la tête à commenter les codes pour des gens qui ne les lisent pas !...

Rechercher des sujets similaires à "deplacer feuilles classeur listbox"