Archivage automatique en fin de mois

[Payou]

Bonjour a tous,

Après avoir fait des recherches sut internet et le forum, je n'arrive pas a trouver ce que je cherche, peut être bien parce que ça n'existe pas

Alors voila, je voudrais savoir s'il existe une fonction macro, qui me permettrait de demander a Excel, chaque fin de mois, de me faire un cut/paste dans un nouveau fichier Excel d'une feuille de mon classeur. pour simplifier on va dire Classeur 1 feuille 1, dans un classeur 2.

Bon après pour ce qui est de donner un nom au classeur en fonction de la date d'extraction, je dois pouvoir trouver ça après en fouinant sur le forum. Bon si jamais vous savez aussi le faire j'avoue que je suis preneur, mais je pourrais me débrouiller dans le cas contraire. La première partie m'intéresse bien plus...

Au plaisir de vous lire,

Payou

 

[Hulk]

Re : Archivage automatique en fin de mois

Hello tout le monde

Pour reprendre l'excellente macro de Mister JC, que je salue , je la modifierai comme ça.

Sub Archivage()
Dim Mois
Mois = Month(Range("H1"))
Application.ScreenUpdating = 0
If Mois < Month(Date) Then
    Select Case MsgBox("Dernier jour du mois !" & Chr(13) & Chr(13) & "Souhaitez-vous copier ce classeur ?", vbOKCancel + vbQuestion, "Confirmation")
        Case vbOK
            Workbooks.Add
            Application.DisplayAlerts = 0
            ActiveWorkbook.SaveAs Filename:="Classeur_Cible_Mois_" & Mois & ".xls"
            Application.DisplayAlerts = 1
            Windows("Classeur_Source.xls").Activate
            Columns("A:H").Copy
            Windows("Classeur_Cible_Mois_" & Mois & ".xls").Activate
            Range("A1").PasteSpecial Paste:=xlPasteValues
            Range("A1").PasteSpecial Paste:=xlPasteFormats
            Range("A1").Select
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            Windows("Classeur_Source.xls").Activate
            Range("A1").Select
            Application.CutCopyMode = False
        Case vbCancel
            Exit Sub
    End Select
 End If
End Sub

De façon à ce qu'il y aille une demande et confirmation de copie

Bon journée.

 

[Brigitte]

Re : Archivage automatique en fin de mois

Bonjour les gars,

Ca m'intéresse aussi votre macro... enfin celle de JC ; juste une tite question, Payou semble vouloir COUPER/COLLER...

chaque fin de mois, de me faire un cut/paste dans un nouveau fichier Excel d'une feuille de mon classeur

Est ce qu'il faut bien mettre

Columns("A:H").Copy

et de ce fait, la source ne va t'elle pas rester intacte, or il semble que cela doive être supprimé ?

Merci d'avance.

 

[JCGL]

Re : Archivage automatique en fin de mois

Bonjour à tous,

Si c'est vraiment ce que souhaite notre ami :

Columns("A:H").Cut

J'ai toujours beaucoup de mal à couper... c'est irrémédiable
Comme le dit Brigitte la source sera inutilisable mais il y a surement un import mensuel...

A+ à tous

 

[Hulk]

Re : Archivage automatique en fin de mois

Re,

Si non, il y a cette version, plus basique, faite avec l'enregistreur de macro..

En PJ.

Cdt, Hulk.

 

[JCGL]

Re : Archivage automatique en fin de mois

Bonjour à tous,

Joli code mon cher Doc Banner, puis-je te proposer ce code sans que tu deviennes Hulk :

Option Explicit

Sub Copie()
    Cells.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & "Archive du " & Format(Range("B2"), "yyyymm") & ".xls"
    ActiveWorkbook.Close
End Sub

Au plaisir de te lire
A+ à tous

 

[Brigitte]

Re : Archivage automatique en fin de mois

Bonjour,

Moi j'essaie de comprendre (c'est déjà ca non ?)

Alors si je prends la dernière macro, JC... est ce que je peux reformuler et tu me dis où j'ai tort :


- elle copie les cellules (mais comment sont elles déterminées)
- elle ouvre un nouveau classeur
- elle sélectionne les cellules précédemment choisies (???) ou sélectionne une zone (???)
- elle colle (ou ?)
- elle sauvegarde le nouveau classeur dans le même répertoire que la source en l'appelant : archives du (avec la date du jour)...
- elle ferme le classeur

J'ai bon ? mais mes questions, tu peux m'aider ?

Et quant au déclenchement de cette macro ? automatique ? à une date donnée ? où le voit on dans le code ?

Merci à toi, ou à Hulk (doc banner)...

 

[Hulk]

Re : Archivage automatique en fin de mois

Re,

Encore mieux JC !

j'apporte tout de même une toute petite ligne en plus et une toute petite correction (le point) à ton oeuvre... comme ceci...

Sub Copie()

    Cells.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    [COLOR="red"][B]Range("A1").Select[/B][/COLOR]
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & "Archive du " & Format(Range("B2"), "yyyy[COLOR="Red"][B].[/B][/COLOR]mm") & ".xls"
    ActiveWorkbook.Close

End Sub

Voilà na

Bonne journée à toi Maestro et aux autres !

 

[Hulk]

Re : Archivage automatique en fin de mois

Re,

Pendant que j'y suis je te réponds Brigitte

Au fait la macro "Copie" copie la feuille active.. entière et enregistre et ferme le nouveau classeur sur le Bureau grâce au ThisWorkbook.Path (au fait grâce au ThisWorkbook.Path il enregistre le classeur dans le même répertoire que le classeur source !).

Ensuite le déclenchement de la macro est dans le code de la feuille et dans le code du ThisWorkbook.

Ce qui donne dans un module standar

Sub Copie()

    Cells.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & "Archive du " & Format(Range("B2"), "yyyy.mm") & ".xls"
    ActiveWorkbook.Close

End Sub

Dans le code de la feuille pour si quand on fait une modif dans la feuille et que c'est le dernier jour du mois, il va demander si l'on veut copier le classeur (cette partie on peut la chouter).

Private Sub Worksheet_Change(ByVal Target As Range)

    If [A2] = [B2] Then
        Select Case MsgBox("Dernier jour du mois !" & Chr(13) & Chr(13) & "Souhaitez-vous copier cette feuille vers un nouveau classeur ?", vbOKCancel + vbQuestion, "Confirmation")
            Case vbOK
                Copie
            Case vbCancel
                Exit Sub
        End Select
    End If

End Sub

Et le même code dans le ThisWorkbook pour qu'à chaque ouverture du fichier il fasse le test If... Si c'est le dernier jour du mois, il lance la macro.

Private Sub Workbook_Open()
    
    If [A2] = [B2] Then
        Select Case MsgBox("Dernier jour du mois !" & Chr(13) & Chr(13) & "Souhaitez-vous copier cette feuille vers un nouveau classeur ?", vbOKCancel + vbQuestion, "Confirmation")
            Case vbOK
                Copie
            Case vbCancel
                Exit Sub
        End Select
    End If

End Sub

J'espère t'avoir aidé

BBye, Hulk.

 

[Brigitte]

Re : Archivage automatique en fin de mois

Re,

Merci Hulk...

ALors :

Au fait la macro "Copie" copie la feuille active.. entière

Ok, ca me manquait ca... cells.copy qui copie TOUTES les cellules, vu.

Je vais faire mon enquiquineuse, je peux ?

ferme le nouveau classeur sur le Bureau grâce au ThisWorkbook.Path (au fait grâce au ThisWorkbook.Path il enregistre le classeur dans le même répertoire que le classeur source !).

Le nouveau classeur se met :

- sur le bureau
- ou bien dans le même répertoire (tu remarqueras que j'avais émis cette idée !! suis pas si bête finalement ?)

??

Merci à toi... pour tous ces éclaircissements. Je vais garder bien au chaud ce fil (qui est bien titré pour une fois)... car il me sera peut être utile.

Payou, tu vas être heureux, tu vas avoir toutes les explications et la solution. Lis bien tout depuis, si je puis me permettre... CAR chaque réponse est une mine d'or pour comprendre.

 

[JCGL]

Re : Archivage automatique en fin de mois

Bonjour à tous,

On pourrait même réduire :

Option Explicit

Sub Copie()
    Cells.Copy 'Copie les cellules de la feuille active
    Workbooks.Add 'Ajoute un classeur
    ActiveSheet.Paste 'Colle les valeurs précédemment copiées
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & "Archive du " & Format(Range("B2"), "yyyymm") & ".xls" 'Sauvegarde le classeur sous un nom déterminé
    ActiveWorkbook.Close 'Ferme le classeur actif
End Sub

Pour "l'automatisme" voir les explication de Doc Banner

A+ à tous

Edition :

Option Explicit

Sub Copie()
    ActiveSheet.UsedRange.Copy 'Copie les cellules "actives" de la feuille active
    Workbooks.Add 'Ajoute un classeur
    ActiveSheet.Paste 'Colle les valeurs précédement copiées
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & "Archive du " & Format(Range("B2"), "yyyymm") & ".xls" 'Sauvegarde le classeur
    ActiveWorkbook.Close 'Ferme le classeur actif
End Sub

 

[Hulk]

Re : Archivage automatique en fin de mois

Re,

Pour compléter les explications et répondre aux questions de Brigitte.

Le nouveau classeur se met :

- sur le bureau
- ou bien dans le même répertoire ?

Ben ça dépend, si le classeur source se trouve sur ton Bureau, le classeur copié sera enregistré sur ton Bureau.

Ou, si tu places le classeur source dans n'importe quel répertoire, où tu veux, le classeur sera enregistré dans ce même repertoire.

Exemple : Si tu crées un nouveau dossier, tu le places où tu veux, et dans ce dossier tu mets le classeur source, ben quand tu feras la copie du classeur source, la copie sera enregistrée dans ce même dossier.

C'est l'effet ThisWorkbook.Path

Attention, il s'agit là, avec cette macro, que de la copie de la feuille active et non pas du classeur entier !

Voili

Cdt, Hulk.

 

[Brigitte]

Re : Archivage automatique en fin de mois

Merci...

Attention, il s'agit là au fait que de la copie de la feuille active et non pas du classeur entier !

??? de quel classeur parles tu ? si la nouvelle feuille se crée, c'est bien dans un nouveau classeur, non ? donc à chaque fin de mois une copie de la feuille active concernée dans un nouveau classeur qui sera sauvegardé dans le même répertoire que le classeur source... C'est pas ca !!

PS je comprends vite, pourvu qu'on m'explique LONGTEMPS

Edit : compris avec ta modif de ton post... C tout bon... Merci boucou.

C'est l'effet IMPULSE, hi hi

 

[Hulk]

Re : Archivage automatique en fin de mois

Re,

Encore une version différente, mais tout autant intéressante.

Celle-çi, si dernier jour du mois demande si on veut copier la feuille active, si oui, il ouvre un classeur qu'on aura préalablement nommé "Archives.xls", reviens sur le classeur source, et copie la feuille vers le classeur "Archives.xls".

Tout ça en classant la feuille en dernière position et la nommant comme la cellule B2, donc une par mois.

Peut-être mieux pour ne pas avoir trop de classeur et donc économiser de la place sur le disque

Je mets le dossier avec le classeur "Archives" en PJ.

Testez en modifiant la date en A1 du Classeur source.

Cdt, Hulk.

 

[Brigitte]

Re : Archivage automatique en fin de mois

Extra !!! moi j'adore... Je suis sûre que Payou va être aux anges avec toutes vos solutions, lui qui ce matin, pensait que ce n'était pas réalisable...

 

[Payou]

Re : Archivage automatique en fin de mois

Bonjour a tous, Brigitte tout d'abord forcement, JCGL, Hulk, PascalXLD.

Alors tout d'abord un grand merci a tous ! Déjà je pensais que ça allait être a la limite du faisable et la... Bah je dois dire que je suis plus que bluffer. Je me doutais bien, au fond, qu'avec les pointure qui rodent sur ce forum qq'un pourrait m'aider mais delà a avoir tant de solution possible !!!!

Je vais bien relire tout ce post - encore une fois - histoire de tout bien comprendre et peut être réussir a en retenir une petite partie, qui sais

Encore une fois un grand merci pour votre aide précieuse, j'ai envie de dire une fois de plus, et vous envoie mes plus sincères remerciement de Singapour

Bonne journée a tous, et au plaisir de vous recroisez autour d'un fil.

Payou

Petit P.S : Merci Brigitte

Juste une petit EDIT: La dernière macro ne fonctionne moi chez moi car j'ai des "/" dans la valeur de cellule et il veux rien savoir. J'ai beau changer le format de la date, bah il me fait la tête... Une solution ? En tout cas la macro est superbe ! Bravo Je dirais presque un petit bijou de macro

Solution: J'ai remplace

ActiveSheet.Name = [B2].Value

par

ActiveSheet.Name = Format(Range("B2"), "dd.mm.yyyy")

trouve dans ton autre code