Enregistre certaine feuille de classeur

Résolu

juer31 Messages postés 114 Date d'inscription Statut Membre Dernière intervention -
Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention - 30 mai 2016 à 15:53

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

Afficher la suite

A voir également:

Enregistre certaine feuille de classeur
Bruler feuille de laurier - Guide
Feuille de pointage excel - Télécharger - Tableur
Feuille a5 - Guide
Comment supprimer une feuille sur word - Guide
Mot de passe enregistré android - Guide

5 réponses

Réponse 1 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

juer31 Messages postés 114 Date d'inscription Statut Membre Dernière intervention 6

Ca bloque à la ligne
ReDim chemin(3) As String

Réponse 2 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

Bonsoir
Effacez la ligne suivante

    Dim chemin As String, nomfichier As String

Cdlt

juer31 Messages postés 114 Date d'inscription Statut Membre Dernière intervention 6

Ca avance merci

Maintenant ca bloque à la ligne
SaveAs Filename:=chemin(i) & nomfichier(i)

Réponse 3 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

juer31 Messages postés 114 Date d'inscription Statut Membre Dernière intervention 6

Ça ne bloque plus. Par contre ça enregistre les copie une par dessus l'autre.

Réponse 4 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

juer31 Messages postés 114 Date d'inscription Statut Membre Dernière intervention 6

Merci d'essayer de m'aider.
Ça donne toujours le même résultat

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

Discussions similaires

Feuille de score belote

feuille excel de gestion belote

Les feuilles Diddl

grille de points pour belote

Reporter valeur sur autre feuille avec critere

Votre réponse

Discussions similaires