Exporter plusieurs feuilles d'un classeur Excel

roudiroud Messages postés 31 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous,

Je voudrais savoir si il est possible d'exporter des feuilles préalablement choisient vers un autre classeur Excel ?

Sachant que je voudrais pouvoir donner le choix à l'utilisateur de choisir le nouvau nom du classeur. Avec une macro VBA.

Pensez-vous que c'est possible?

merci d'avance
A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 714
 
erreur de personne .................
1
Stif
 
Ah désolé il me semblait avoir répondu au sujet pourtant...
Et concernant votre réponse précédente qui a disparue..... "No Comment"
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 714 > Stif
 
Re,

Vous avez bien repondu, c'est moi qui me suis trompe precedemment.
0
Stif
 
Ok, je ne comprenais pas pourquoi une telle réponse...

Bonne journée à vous,
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 714 > Stif
 
Re,

une autre facon de faire avec quelques tests et sans entrer le nombre de feuilles
Tout dependra aussi du type de choix pour les feuilles 

Option Explicit

Sub nouv_classeur()
    Dim nomclasseur1 As String, nomclasseur2 As String, feuillesàcopier As String, feuillesAcopier
    Dim numérodefeuilles As Integer, nombredefeuilles As Integer, feuilleencours As Integer
    Dim newBook As Workbook, NSh, Nom
    Dim I As Variant, x, xx
    
    nomclasseur1 = ActiveWorkbook.Name
    nomclasseur2 = InputBox("Nom du classeur", "Renseignez les noms du classeur à créer")
    If nomclasseur2 = "" Then MsgBox "Pas de nom de classeur!!!!!!!!!!!!!!!": Exit Sub
    feuillesàcopier = InputBox("Séparez les numéros par des virgules , ", "Renseignez les numéros de feuilles à copier")
    If feuillesàcopier = "" Then MsgBox "Pas de feuille(s) a copier!!!!!!!!!!!!!!!": Exit Sub

    feuillesAcopier = Split(feuillesàcopier, ",")
    'verif si numeros sont des entiers
    If Not verifNumero(feuillesAcopier) Then Exit Sub
    '
    If UBound(feuillesAcopier) = 0 Then
        nombredefeuilles = 1
    Else
        nombredefeuilles = UBound(feuillesAcopier) + 1
    End If
    If nombredefeuilles > Workbooks(nomclasseur1).Sheets.Count Then
        MsgBox "ATTENTION le classeur source ne contient que " & _
                        Workbooks(nomclasseur1).Sheets.Count & " feuilles / Impossible d'en exporter plus"
        Exit Sub
    End If

    Set newBook = Workbooks.Add
    With newBook
        .SaveAs Filename:="d:\_acsv1\" & nomclasseur2 + ".xls"
    End With
    nomclasseur2 = ActiveWorkbook.Name
    On Error Resume Next
    For NSh = 1 To nombredefeuilles
        Nom = Workbooks(nomclasseur1).Sheets(CInt(feuillesAcopier(NSh - 1))).Name
        Workbooks(nomclasseur1).Sheets(Nom).Copy After:=Workbooks(nomclasseur2).Sheets(Sheets.Count)
    Next NSh
    newBook.Close True
End Sub

Function verifNumero(feuillesAcopier) As Boolean
    Dim NF, Flag_Nok As Boolean, MSG, x
    On Error GoTo Table
    
    For NF = 0 To UBound(feuillesAcopier)
        x = CInt(feuillesAcopier(NF))
suite:
    Next NF
    If Not Flag_Nok Then
        verifNumero = True
    Else
        verifNumero = False
        MsgBox "Attention au separateur entre les numeros de feuille!!!!!" & vbNewLine & _
                        MSG, vbOKOnly, "ERREUR DE SEPARATEUR!!!!!"
    End If
    On Error GoTo 0
    Exit Function
Table:
    Flag_Nok = True
    MSG = MSG & feuillesAcopier(NF) & vbNewLine
    GoTo suite
End Function
0
Réponse 2 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 714
 
Bonjour,

Comment sont choisies les feuilles ???
0
Réponse 3 / 3
Stif
 
Bonjour,
avec le peu de précisions de votre demande, je vous propose ces quelques lignes :

Option Explicit


Sub nouv_classeur()

Dim nomclasseur1 As String, nomclasseur2 As String, feuillesàcopier As String
Dim numérodefeuilles As Integer, nombredefeuilles As Integer, feuilleencours As Integer
Dim newBook As Workbook
Dim I As Variant

nomclasseur1 = ActiveWorkbook.Name

nomclasseur2 = InputBox("Nom du classeur", "Renseignez les noms du classeur à créer")
nombredefeuilles = InputBox("Entrez un nombre", "Combien de feuilles voulez vous copier?")
feuillesàcopier = InputBox("Séparez les numéros par des virgules , ", "Renseignez les numéros de feuilles à copier")
feuillesàcopier = feuillesàcopier & ","

Set newBook = Workbooks.Add
With newBook
.SaveAs Filename:=nomclasseur2 + ".xls"
End With
nomclasseur2 = ActiveWorkbook.Name
If nombredefeuilles <= Workbooks(nomclasseur1).Sheets.Count Then
If nombredefeuilles > 1 Then
For I = 1 To nombredefeuilles
If InStr(1, feuillesàcopier, ",") = 0 Then
MsgBox "Attention une ou plusieurs feuille(s) non exportée(s) - Peut-être un oubli lors de la saisie..."
Exit For
End If
feuilleencours = Mid(feuillesàcopier, 1, InStr(1, feuillesàcopier, ",") - 1)
feuillesàcopier = Mid(feuillesàcopier, InStr(1, feuillesàcopier, ",") + 1, Len(feuillesàcopier))
Workbooks(nomclasseur1).Sheets(feuilleencours).Copy After:=Workbooks(nomclasseur2).Sheets(Sheets.Count)
Next I
Else
feuilleencours = Val(feuillesàcopier)
Workbooks(nomclasseur1).Sheets(feuilleencours).Copy After:=Workbooks(nomclasseur2).Sheets(Sheets.Count)
End If
Else: MsgBox "ATTENTION le classeur source ne contient que " & Workbooks(nomclasseur1).Sheets.Count & " feuilles / Impossible d'en exporter plus"
End If
End Sub

A votre disposition pour d'éventuels renseignements ou modifications.
Cordialement,
0