Enregistre certaine feuille de classeur

Résolu/Fermé

juer31 Messages postés 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 - 19 mai 2016 à 22:16
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 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

A voir également:

Enregistre certaine feuille de classeur
Feuille de pointage excel - Télécharger - Tableur
Mot de passe enregistré - Guide
Feuille a5 - Guide
Feuille de style word - Guide
Supprimer une feuille word - Guide

5 réponses

Réponse 1 / 5

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
20 mai 2016 à 15:35

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 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 6
20 mai 2016 à 17:04

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

Réponse 2 / 5

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
20 mai 2016 à 20:47

Bonsoir
Effacez la ligne suivante

    Dim chemin As String, nomfichier As String

Cdlt

juer31 Messages postés 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 6
20 mai 2016 à 20:56

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 lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
21 mai 2016 à 05:21

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 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 6
25 mai 2016 à 18:19

Ç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 lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
27 mai 2016 à 08:55

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 107 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 25 mars 2024 6
30 mai 2016 à 14:01

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 lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
30 mai 2016 à 15:53

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

Reporter valeur sur autre feuille avec critere

grille de points pour belote

Copier une feuille d'un classeur qui s'actualise

Discussions similaires

Newsletters