sauvegarde et effacement de données

[mix770]

Bonjour le forum,
je souhaiterai avoir un document qui en fin d'année permet:
- de faire une copie du fichier
- de supprimer toutes les lignes dans chaque onglet (un par pôle)
j'ai construit avec mes moyens mais bon, c'est une macro lourde, je ne sais pas comment intégrer la copie du fichier et redéfinir la zone d'impression par page.
l’idéal serai que cette action soit protégée par un mot de passe quand on clic sur le bouton de lancement de la macro.

j'ai ci dessous une macro pas très académique..., merci à vous pour votre aide.


Sub Efface_Données_2()
'
' selectionner les lignes et supprimer
Sheets("Pôle Restauration").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp
'selectionner ligne et vider contenu
Range("B8:H8").Select
Selection.ClearContents
' selectionner cellule qui additionne les kilometres et réinscrire formule
Range("G4").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C:R[1500]C)"

Sheets("Pôle Compétences").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp
Range("B8:H8").Select
Selection.ClearContents
Range("G4").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C:R[1500]C)"
Sheets("Pôle Séjour Activité").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp
Range("B8:H8").Select
Selection.ClearContents
Range("G4").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C:R[1500]C)"
Sheets("Pôle Maintenance").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp
Range("B8:H8").Select
Selection.ClearContents
Range("G4").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C:R[1500]C)"
Sheets("Pôle RH").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp
Range("B8:H8").Select
Selection.ClearContents
'revenir à la page accueil
Sheets("ACCUEIL").Select
Range("A1").Select
End Sub


cordialement.

 

[titiborregan5]

Re : sauvegarde et effacement de données

Bonjour Mix, le forum,

il faut éviter au maximum les select qui alourdissent beaucoup le traitement.

Du coup,

' selectionner les lignes et supprimer
Sheets("Pôle Restauration").Select
Rows("9:1600").Select
Selection.Delete Shift:=xlUp

devient

Sheets("Pôle Restauration").Rows("9:1600").Delete Shift:=xlUp

A adapter aux autres codes...
Bon courage

 

[Robert]

Re : sauvegarde et effacement de données

Bonjour le fil, bonjour le forum,

D'accord avec Titiborregan au sujet des Select...
Essaie comme ça :

Sub Efface_Données_2()
Dim o As Object 'déclare la variable o (Onglet)

For Each o In Sheets 'boucle sur tous les onglets du classeur
    Select Case o.Name 'agit en fonction du nom de l'onglet
        Case "Pôle Restauration", "Pôle Compétences", "Pôle Séjour Activité", "Pôle Maintenance", "Pôle RH" 'cas
            With o 'prend en compte l'onglet
                ' selectionner les lignes et supprimer
                .Rows("9:1600").Delete Shift:=xlUp
                'selectionner ligne et vider contenu
                .Range("B8:H8").ClearContents
                ' selectionner cellule qui additionne les kilometres et réinscrire formule
                .Range("G4").FormulaR1C1 = "=SUM(R[4]C:R[1500]C)"
            End With 'fin de la prise en compte de l'onglet
            o.PageSetup.PrintArea = "$B$8:$H$8" 'définit la zone d'impression (à adapter)
            o.Protect Password:="toto" 'protège l'onglet par mot de passe (à adapter)
    End Select 'fin de l'action en fonction du nom de l'onglet
Next o 'prochain onglet de la boucle
Sheets("ACCUEIL").Select 'si au départ tu es déjà dans l'onglet "ACCUEIL", cette ligne n'est plus nécessaire...
Range("A1").Select 'si au départ tu es déjà dans la cellule A1, cette ligne n'est plus nécessaire...
End Sub

si ton classeur ne comporte que les 5 onglets cités dans le Case, tu peux supprimer les trois lignes :

    Select Case o.Name 'agit en fonction du nom de l'onglet
        Case "Pôle Restauration", "Pôle Compétences", "Pôle Séjour Activité", "Pôle Maintenance", "Pôle RH" 'cas
    End Select 'fin de l'action en fonction du nom de l'onglet