Enregistre certaine feuille de classeur

Résolu
juer31 Messages postés 120 Statut Membre -  
Frenchie83 Messages postés 2254 Statut Membre -
Bonjour,

J'aimerais enregistrer certaine feuille seulement de mon classeur en créant une copie de celle ci.
Présentement je sauvegarde la feuille active "Données" mais je sais pas trop comment faire pour sauvegarder les deux autres feuilles. Soit feuille "coûts" et feuille "data"

Voici mon code

Sub ENREGISTRER()
'Macro par JUER
Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xlsx"
chemin = "G:\02 - DATA\" & Range("E9") & "\"
nomfichier = "Calcul - " & ActiveSheet.Range("E9") & " - " & Range("C9") & extension
With ActiveWorkbook
.ActiveSheet.DrawingObjects(1).Delete
.SaveAs Filename:=chemin & nomfichier
.Close
End With
End Sub

Merci

5 réponses

  1. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    essayez ceci, (pas les moyens de tester)
    Sub ENREGISTRER()
    'Macro par JUER
        Dim extension As String
        Dim chemin As String, nomfichier As String
        Dim style As Integer
        Application.ScreenUpdating = False
        ThisWorkbook.ActiveSheet.Copy
        extension = ".xlsx"
        ReDim chemin(3) As String
        ReDim nomfichier(3) As String
        For i = 1 To 3
            chemin(i) = "G:\02 - DATA\" & Range("E9") & "\"
            nomfichier(i) = "Calcul - " & ActiveSheet.Range("E9") & " - " & Range("C9") & extension
            With ActiveWorkbook
                .ActiveSheet.DrawingObjects(1).Delete
                .SaveAs Filename:=chemin(i) & nomfichier(i)
                .Close
            End With
        Next i
    End Sub
    

    Cdlt
    0
    1. juer31 Messages postés 120 Statut Membre 6
       
      Ca bloque à la ligne
      ReDim chemin(3) As String
      0
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonsoir
    Effacez la ligne suivante
        Dim chemin As String, nomfichier As String

    Cdlt
    0
    1. juer31 Messages postés 120 Statut Membre 6
       
      Ca avance merci

      Maintenant ca bloque à la ligne
      SaveAs Filename:=chemin(i) & nomfichier(i)
      0
  3. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Essayez ceci
    Sub ENREGISTRER()
    'Macro par JUER
        Dim extension As String
        Dim style As Integer
        Application.ScreenUpdating = False
        ReDim chemin(3) As String
        ReDim nomfichier(3) As String
        For i = 1 To 3
            ThisWorkbook.ActiveSheet.Copy
            extension = ".xlsx"
            chemin(i) = "G:\02 - DATA\" & Range("E9") & "\"
            nomfichier(i) = "Calcul - " & ActiveSheet.Range("E9") & " - " & Range("C9") & extension
            With ActiveWorkbook
                .ActiveSheet.DrawingObjects(1).Delete
                .SaveAs Filename:=chemin(i) & nomfichier(i)
                .Close
            End With
        Next i
    End Sub
    

    Cdlt
    0
    1. juer31 Messages postés 120 Statut Membre 6
       
      Ça ne bloque plus. Par contre ça enregistre les copie une par dessus l'autre.
      0
  4. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Option Compare Text
    
    Sub ENREGISTRER()
    'Macro par JUER
        Dim extension As String
        Dim style As Integer
        Application.ScreenUpdating = False
        ReDim chemin(3) As String
        ReDim nomfichier(3) As String
        NbFeuil = Sheets.Count
        For i = 1 To NbFeuil
            If ThisWorkbook.Sheets(i).Name = "Données" Or ThisWorkbook.Sheets(i).Name = "Coûts" Or ThisWorkbook.Sheets(i).Name = "Data" Then
                ThisWorkbook.ActiveSheet.Copy
                extension = ".xlsx"
                chemin(i) = "G:\02 - DATA\" & Range("E9") & "\"
                nomfichier(i) = "Calcul - " & ActiveSheet.Range("E9") & " - " & Range("C9") & extension
                With ActiveWorkbook
                    .ActiveSheet.DrawingObjects(1).Delete
                    .SaveAs Filename:=chemin(i) & nomfichier(i)
                    .Close
                End With
            End If
        Next i
    End Sub

    A tester
    Cdlt
    0
    1. juer31 Messages postés 120 Statut Membre 6
       
      Merci d'essayer de m'aider.
      Ça donne toujours le même résultat
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Rajouter la ligne suivante
      Sheets(i).Select

    après la ligne
    If ThisWorkbook.Sheets(i).Name = "Données" Or ThisWorkbook.Sheets(i).Name = "Coûts" Or ThisWorkbook.Sheets(i).Name = "Data" Then

    Ce qui donne
    If ThisWorkbook.Sheets(i).Name = "Données" Or ThisWorkbook.Sheets(i).Name = "Coûts" Or ThisWorkbook.Sheets(i).Name = "Data" Then
        Sheets(i).Select<code basic>

    </code>
    Cdlt
    0