Creer nouveau classeur avec feuilles selectionnees

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

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

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

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

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

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