Creer nouveau classeur avec feuilles selectionnees

Francois73 · 7 Juin 2013

bonjour le forum

j'ai un souci qui peut vous paraître simple
je cherche , depuis un premier classeur à sélectionner toutes les feuilles qui commencent par CLNC et à les copier dans un nouveau classeur (à créer)

je pense avoir réussi à sélectionner les feuilles en questions mais je bloque sur la création du nouveau classeur et de la copie de ces feuilles

voici le code

Sub exportclincomplet()
Dim x As Integer, Feuille As Object
Application.DisplayAlerts = False
Sheets(1).Select
For Each Feuille In Worksheets
If Left(Feuille.Name, 4) = "CLNC" Then
If x = 0 Then
Feuille.Activate
x = 1
End If
Sheets(Feuille.Name).Select Replace:=False
End If
Next Feuille
ActiveWindow.SelectedSheets.Copy
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\courbois_f\Documents\ECRITURE EXCEL LACTO\lacto siege\CLNC.xlsm"
ActiveWindow.SelectedSheets.Paste ( c'est la ligne qui bloque)
Application.DisplayAlerts = True

merci de votre aide

Pierrot93 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Bonjour,

modifie peut être la fin comme suit :

Code:

Dim wb As Workbook
'code
Set wb = Workbooks.Add
Windows(ThisWorkbook.Name).SelectedSheets.Copy after:=wb.Sheets(wb.Sheets.Count)

bonne journée
@+

Efgé · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Bonjour François73, Salut Pierrot 🙂

Une autre méthode:

VB:

Sub Test()
Dim Tableau As Variant, F As Worksheet
For Each F In Worksheets
    If F.Name Like "CLNC*" Then
        If Not IsArray(Tableau) Then
            Tableau = Array(F.Name)
        Else
            ReDim Preserve Tableau(UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = F.Name
        End If
    End If
Next F
If IsArray(Tableau) Then
    Worksheets(Tableau).Copy
    'ActiveWorkbook.SaveAs "C:\Users\courbois_f\Documents\ECRITURE EXCEL LACTO\lacto siege\CLNC.xlsm"
End If
End Sub

Cordialement

ROGER2327 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Bonjour à tous.

Une autre :

VB:

Sub Toto()
Dim TF As Boolean, Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name Like "CLNC*" Then
            If TF Then Feuille.Copy After:=ActiveWorkbook.Sheets(1) Else Feuille.Copy: TF = True
        End If
    Next
    If TF Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs "C:\Users\courbois_f\Documents\ECRITURE EXCEL LACTO\lacto siege\CLNC.xlsm"
        Application.DisplayAlerts = True
    End If
End Sub

ROGER2327
#6663

Samedi 21 Merdre 140 (Sainte Pyrotechnie, illuminée - fête Suprême Quarte)
19 Prairial An CCXXI, 3,6103h - tilleul
2013-W23-5T08:39:53Z

Francois73 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

bonjour a tous

et merci
pour vos réponse j'ai complété le code de Efgé en ajoutant un enregistrement du fichier

merci
Sub exportclincomplet()
Dim Tableau As Variant, F As Worksheet
For Each F In Worksheets
If F.Name Like "CLNC*" Then
If Not IsArray(Tableau) Then
Tableau = Array(F.Name)
Else
ReDim Preserve Tableau(UBound(Tableau) + 1)
Tableau(UBound(Tableau)) = F.Name
End If
End If
Next F
If IsArray(Tableau) Then
Worksheets(Tableau).Copy
'ActiveWorkbook.SaveAs "C:\Users\courbois_f\Documents\ECRITURE EXCEL LACTO\lacto siege\CLNC.xlsm"
End If
Dim nom As String
nom = InputBox("INDIQUEZ LE NOM DE SAUVEGARDE COMMENCANT PAR CLNC ")
If nom <> "" Then
With ThisWorkbook
.SaveCopyAs .Path & "\" & nom & ".xlsm"
End With
End If
End Sub

Efgé · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Re
Je ne suis pas sûr d'avoir bien compris ce que tu es en train de faire.
Ton code ne sauvegarde pas le nouveau classeur créé, mais fait une copie (.SaveCopyAs ) du classeur d'origine.
Est-ce ce que tu veux faire ?
Cordialement

Francois73 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

non effectivement je viens de m'en rendre compte , il sauvegarde effectivement le fichier source, alors que ce que je cherche à faire c'est sauvegarder le fichier créer en choisissant le nom par l'intermédiaire de la box

pour l'instant je cherche encore

j'ai ajouté une ligne pour fermer le fichier une fois enregistrée (mais encore une fois ce n'est pas le bon qui s'enregistre)
tu as vraiment l'œil, je suis admiratif

ROGER2327 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Re...

Francois73 à dit:
(...) il sauvegarde effectivement le fichier source, alors que ce que je cherche à faire c'est sauvegarder le fichier créer (...)

Je crois bien que ma proposition fait cela.

Il suffit d'y ajouter la demande du nom...

ROGER2327
#6664

Samedi 21 Merdre 140 (Sainte Pyrotechnie, illuminée - fête Suprême Quarte)
19 Prairial An CCXXI, 4,1790h - tilleul
2013-W23-5T10:01:47Z

Francois73 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

bonjour Roger2327

et merci pour ta réponse, pour être plus précis, pour l'enregistrement, je souhaite qu'il enregistre le nouveau fichier dans le même dossier que le fichier source, et l'idée de l'ouverture d'une box me permet de choisir le nom pour enregistrer sachant que l'impératif est que cela commence par CLNC et qui sera suivi par exemple d'une date
merci

ROGER2327 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Suite...

... comme ceci ?

VB:

Sub Toto()
Dim TF As Boolean, Nom$, Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name Like "CLNC*" Then
            If TF Then Feuille.Copy After:=ActiveWorkbook.Sheets(1) Else Feuille.Copy: TF = True
        End If
    Next
    If TF Then
        Nom = InputBox("INDIQUEZ LE NOM DE SAUVEGARDE COMMENCANT PAR CLNC ")
        If Nom Like "CLNC*" Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs "C:\Users\courbois_f\Documents\ECRITURE EXCEL LACTO\lacto siege\" & Nom & ".xlsm"
            Application.DisplayAlerts = True
        End If
    End If
End Sub

ROGER2327
#6665

Samedi 21 Merdre 140 (Sainte Pyrotechnie, illuminée - fête Suprême Quarte)
19 Prairial An CCXXI, 4,2301h - tilleul
2013-W23-5T10:09:08Z

Efgé · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Re, Bonjour Roger,
En partant de ma proposition, essais comme ceci:

VB:

Sub Test_2()
Dim Tableau As Variant, F As Worksheet, Nom$

For Each F In Worksheets
    If F.Name Like "CLNC*" Then
        If Not IsArray(Tableau) Then
            Tableau = Array(F.Name)
        Else
            ReDim Preserve Tableau(UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = F.Name
        End If
    End If
Next F

If IsArray(Tableau) Then
    Application.ScreenUpdating = False
    Worksheets(Tableau).Copy
    Nom = Application.InputBox("INDIQUEZ LE NOM DE SAUVEGARDE COMMENCANT PAR CLNC ", "Choix du nom", "CNLC-" & Format(Date, "yyyymmdd"), , , , , 2)
    If Nom < > "" Then ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom & ".xlsm"
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
End If

End Sub

Cordialement

Francois73 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

re bonjour Efgé

effectivement ça marche avec cependant un petit souci, il n'accepte pas l'extention xlsm , si je met xlsx ça fonctionne
dans la ligne
If Nom < > "" Then ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom & ".xlsm"

ROGER2327 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Re...

Francois73 à dit:
(...) pour l'enregistrement, je souhaite qu'il enregistre le nouveau fichier dans le même dossier que le fichier source, et l'idée de l'ouverture d'une box me permet de choisir le nom pour enregistrer sachant que l'impératif est que cela commence par CLNC et qui sera suivi par exemple d'une date
merci

VB:

Sub Toto()
Dim TF As Boolean, Nom$, Chemin$, Feuille As Worksheet
    With ThisWorkbook
        Chemin = .Path
        For Each Feuille In .Worksheets
            If Feuille.Name Like "CLNC*" Then
                If TF Then Feuille.Copy After:=ActiveWorkbook.Sheets(1) Else Feuille.Copy: TF = True
            End If
        Next
    End With
    If TF Then
        Nom = InputBox("INDIQUEZ LE NOM DE SAUVEGARDE COMMENCANT PAR CLNC ")
        If Nom Like "CLNC*" Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Nom & ".xls"
            Application.DisplayAlerts = True
        End If
    End If
End Sub

(Peut-être ...)

ROGER2327
#6666

Samedi 21 Merdre 140 (Sainte Pyrotechnie, illuminée - fête Suprême Quarte)
19 Prairial An CCXXI, 4,4026h - tilleul
2013-W23-5T10:33:59Z

Francois73 · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

re bonjour Roger2327

ton code à l'air de fonctionner im me demande bien le nom de fichier pour l'enregistrer le souci, je ne retrouve pas le fichier dans le dossier "lacto siege" et je ne sais pas ou il est

merci de votre patiente

Efgé · 7 Juin 2013

Re : Creer nouveau classeur avec feuilles selectionnees

Re
Pour ma part....
Je suis sous 2003, donc difficile d'enregistrer sous .XLSM
Fais un test:
Ouvre un nouveau fichier, lance l'enregistreur de macro puis enregistre le classeur sour xlsm.
Arrête l'enregistrement puis regarde le code proposé.

Mais si ma proposition ne donne pas le résulat escompté, je doute que ton premier code ne l'ai donné....

Cordialement

Effectuez une recherche sur Excel Downloads...

Creer nouveau classeur avec feuilles selectionnees

Francois73

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Francois73

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

Francois73

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Francois73

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Francois73

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Francois73

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée