extraire feuilles vers un nouveau classeur grace à un usf

Bonjour,

Un petit exemple : http://cjoint.com/?BIowoY7bAgu

Merci MichD

j'avais testé quelque chose comme toi sauf que si je selectionne 2 feuill es dans mon usf il n'en copie qu'une

ceci dit ton code est encore une fois beaucoup plus fluide que le mien.

quid?

est seulement possible?



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)).copy
Next
End With
UserForm1.Show
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

Dans le formulaire,

Utilise ceci en lieu et place de l'autre :

'--------------------------------------
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'Avec le listbox
With Me.ListBox1
'Pour chaque item du listbox
For a = 0 To .ListCount - 1
'si l'item est sélectionné
If .Selected(a) = True Then
'Extrait le nom de la feuille
NomFeuille = .List(a)
'copie cette feuille unique vers un nouveau classeur
ThisWorkbook.Worksheets(NomFeuille).Copy
End If
Next
End With
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox "Terminé."
End Sub
'--------------------------------------




"magic-dd" a écrit dans le message de groupe de discussion :
9d71631f-8d8e-4a11-9ed7-cbaa9c3dcc20@googlegroups.com...

Merci MichD

j'avais testé quelque chose comme toi sauf que si je selectionne 2 feuilles
dans mon usf il n'en copie qu'une

ceci dit ton code est encore une fois beaucoup plus fluide que le mien.

quid?

est seulement possible?



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)).copy
Next
End With
UserForm1.Show
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

on y est presque

jecherche aussi de mon coté mais tu m'as deja mis une longueur d'avance

donc le souci est qu'il créé autant de classeur que de feuille selectio nées dans la list box

grrr


Le vendredi 14 septembre 2012 21:51:51 UTC+2, magic-dd a écrit :

bonjour



je possede un classeur avec x onglets



j'ai reussi a force de recherche à lister tous les onglets de mon class eur dans un userform



mon but est de selectionner certains onglets listés dans ce userform et qu'a la validation cela les copie dans un nouveau classeur



voici mon code



Private Sub UserForm_Activate()

For Each sh In Worksheets

Next sh

End Sub



merci

Bonsoir,

A défaut de Denis (au diner peut-être)
;o))
Ce code de Denis modifié copie toutes les feuilles sélectionnées dans la listebox vers UN nouveau classeur
'------------------------
Private Sub CommandButton1_Click()
Dim DejaOuvert As Boolean
DejaOuvert = True
Application.ScreenUpdating = False
'Avec le listbox
With Me.ListBox1
'Pour chaque item du listbox
For a = 0 To .ListCount - 1
'si l'item est sélectionné
If .Selected(a) = True Then
'Extrait le nom de la feuille
NomFeuille = .List(a)
'copie cette feuille unique vers un nouveau classeur
If DejaOuvert = True Then
ThisWorkbook.Worksheets(NomFeuille).Copy
DejaOuvert = False
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = NomFeuille
End If
End If
Next
End With
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox "Terminé."
End Sub
'----------------------------
--
Salutations
JJ


"magic-dd" <ciolandre@gmail.com> a écrit dans le message de news:
09b00eaa-a8c8-49e5-825d-697c787438ea@googlegroups.com...
on y est presque

jecherche aussi de mon coté mais tu m'as deja mis une longueur d'avance

donc le souci est qu'il créé autant de classeur que de feuille selectionées dans la list box

grrr


Le vendredi 14 septembre 2012 21:51:51 UTC+2, magic-dd a écrit :

bonjour



je possede un classeur avec x onglets



j'ai reussi a force de recherche à lister tous les onglets de mon classeur dans un userform



mon but est de selectionner certains onglets listés dans ce userform et qu'a la validation cela les copie
dans un nouveau classeur



voici mon code



Private Sub UserForm_Activate()

For Each sh In Worksheets

Next sh

End Sub



merci

Oupss !!
J'ai oublié la copie des feuilles
'----------------
Private Sub CommandButton1_Click()
Dim DejaOuvert As Boolean, NomDuclasseur As String, ClasseurCible As String
DejaOuvert = True
NomDuclasseur = ThisWorkbook.Name
Application.ScreenUpdating = False
'Avec le listbox
With Me.ListBox1
'Pour chaque item du listbox
For a = 0 To .ListCount - 1
'si l'item est sélectionné
If .Selected(a) = True Then
'Extrait le nom de la feuille
NomFeuille = .List(a)
If DejaOuvert = True Then
ThisWorkbook.Worksheets(NomFeuille).Copy
ClasseurCible = ActiveWorkbook.Name
DejaOuvert = False
Else
Workbooks(NomDuclasseur).Worksheets(NomFeuille).Copy _
After:=Workbooks(ClasseurCible).Worksheets(Workbooks(ClasseurCible).Worksheets.Count)
End If
End If
Next
End With
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox "Terminé." & vbLf & "Nom du nouveau classeur: " & ClasseurCible
End Sub
'--------------

Sous l'oeil vigilant de Denis
;o)
--
Salutations
JJ

Bonjour les champions excel

merci pour ce bout de code qui m'a donné du fil à retorde

tout fonctionne, seulement est il possible lors du transfert des feuilles d emander ou sauvegarder le nouveau classeur, faire la copie et le fermer afi n de revenir sur le classeur source.

merci

Si tu veux copier tous les onglets dans le même nouveau fichier :

'---------------------------------------------
Private Sub CommandButton1_Click()
Dim A As Integer, T(), B As Integer

'Avec le listbox
With Me.ListBox1
If .ListIndex = 0 And .Selected(0) = False Then Exit Sub
Application.ScreenUpdating = False
'Pour chaque item du listbox
For A = 0 To .ListCount - 1
'si l'item est sélectionné
If .Selected(A) = True Then
'Extrait le nom de la feuille
ReDim Preserve T(B)
T(B) = .List(A)
B = B + 1
End If
Next
ThisWorkbook.Sheets(T).Copy
End With
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub
'---------------------------------------------




"magic-dd" a écrit dans le message de groupe de discussion :
09b00eaa-a8c8-49e5-825d-697c787438ea@googlegroups.com...

on y est presque

jecherche aussi de mon coté mais tu m'as deja mis une longueur d'avance

donc le souci est qu'il créé autant de classeur que de feuille selectionées
dans la list box

grrr


Le vendredi 14 septembre 2012 21:51:51 UTC+2, magic-dd a écrit :

bonjour



je possede un classeur avec x onglets



j'ai reussi a force de recherche à lister tous les onglets de mon classeur
dans un userform



mon but est de selectionner certains onglets listés dans ce userform et
qu'a la validation cela les copie dans un nouveau classeur



voici mon code



Private Sub UserForm_Activate()

For Each sh In Worksheets

Next sh

End Sub



merci

Private Sub CommandButton1_Click()
Dim A As Integer, T(), B As Integer
Dim Chemin As String

Chemin = "D:Anglais" 'Le chemin du répertoire où
'tu veux enregistrer ton fichier.
'Avec le listbox
With Me.ListBox1
If .ListIndex = 0 And .Selected(0) = False Then Exit Sub
Application.ScreenUpdating = False
'Pour chaque item du listbox
For A = 0 To .ListCount - 1
'si l'item est sélectionné
If .Selected(A) = True Then
'Extrait le nom de la feuille
ReDim Preserve T(B)
T(B) = .List(A)
B = B + 1
End If
Next
ThisWorkbook.Sheets(T).Copy
Application.Dialogs(xlDialogSaveAs).Show Chemin & ActiveWorkbook.Name
If ActiveWorkbook.Saved Then
ActiveWorkbook.Close False
End If

End With
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub

Merci MichD

mais a forc de mofifier tous mes fichiers, plus rien ne marche

pourrais tu stp m'envoyer un cjoint pour que je reparte sur de bonnes bases