Creer nouveau classeur avec feuilles selectionnees

[Francois73]

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

 

[Francois73]

Re : Creer nouveau classeur avec feuilles selectionnees

merci pour vos info,
je m'en suis sorti , je garderai le fichier xlsx en archive
et je l'importe dans un classeur xlsm pour mettre en place mes macro

je vous remercie vivement et vous souhaite bon après midi et bon week end
a bientôt sur le forum

 

[ROGER2327]

Re : Creer nouveau classeur avec feuilles selectionnees

Re...

(...) ç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"

Pour enregistrer avec l'extension .xlsm :​

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 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.DisplayAlerts = True
        End If
    End If
End Sub

FileFormat:=xlOpenXMLWorkbookMacroEnabled

est indispensable.​

Bonne soirée.


ROGER2327
#6667

Samedi 21 Merdre 140 (Sainte Pyrotechnie, illuminée - fête Suprême Quarte)
19 Prairial An CCXXI, 6,4180h - tilleul
2013-W23-5T15:24:11Z

 

[Francois73]

Re : Creer nouveau classeur avec feuilles selectionnees

bonjour

j'ai oublié de remercier tous le monde

merci
A+