Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide afin de modifier une macro pour archiver.
En fait je voudrais archiver des données avec dates colonne A (chaque mois...) et si le mois est déjà archivé afficher une MsgBox avec le choix d'écraser ou non l'archive...

voir fichier joint.

Merci pour votre aide, si précieuse.
Bien amicalement,
Christian

 

[Robert]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Bonjour Christian, bonjour le forum,

je ne réponds pas (encore) à ta question mais la première ligne de ton code me pose un problème :

Range("FC12:FW69" & Sheets("Planning").Range("FC69").End(xlUp).Row).Copy

Quelle est la plage que tu désires copier ?

 

[Christian0258]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Re, le forum, Robert,

Effectivement, la plage à copier est "maintenant" FC12:FW82.
Mes excuses pour la mauvaise plage à copier.

Merci Robert,
Bien à toi.
Christian

 

[camarchepas]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Bonjour Robert, Christian , Le Forum

@ Et oui bien vu Robert

Voici une solution sans trop dénaturer le code d'origine :

Sub Archivage()
'Procédure d'archivage
 Dim Trouve As Range
 Dim Reponse As Byte
 
 'Vérification présence élément dans archives
  Set Trouve = Sheets("Archives").Range("A:A").Find(Sheets("Planning").Range("FC12"), lookat:=xlWhole)
  If Not Trouve Is Nothing Then
    Reponse = MsgBox("Sauvegarde déjà présente , voulez-vous l'écraser ?", vbYesNo, "ATTENTE REPONSE UTILISATEUR")
    If Reponse <> vbYes Then MsgBox "Pas d'archivage", vbCritical, "INFORMATION UTILISATEUR": Exit Sub
  End If
  
 'Archivage
  Sheets("Planning").Range("FC12:FW" & Sheets("Planning").Range("FC65536").End(xlUp).Row).Copy
  Sheets("Archives").Select
  Range("A" & Sheets("Archives").Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
  Application.CutCopyMode = False
    
  'Retour au planning
   Sheets("Planning").Select
   Range("FC11").Select
 End Sub

 

[Christian0258]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Re, le forum, Robert, camarchepas

Merci pour votre aide.

Après essais, ça ne fonctionne pas totalement.
Lorsque je lance l'archivage, pas de problème ça archive bien.
Si je relance l'archivage du même mois, la macro me propose bien de réarchiver ou pas, si je lance, pour écraser, en fait ça place à la suite la 2ème archives...

En fait dans mon fichier j'ai des formats conditionnels et des commentaires que je copie dans cette macro, est-ce que le problème n'est pas là ?...

Merci pour votre aide.
Bien à vous,
Christian

 

[camarchepas]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Re moi ,

Comme cela ça devrait être plus top

Sub Archivage()
'Procédure d'archivage
 Dim Trouve As Range
 Dim Reponse As Byte
 
 'Vérification présence élément dans archives
  Set Trouve = Sheets("Archives").Range("A:A").Find(Sheets("Planning").Range("FC12"), lookat:=xlWhole)
  If Not Trouve Is Nothing Then
    Reponse = MsgBox("Sauvegarde déjà présente , voulez-vous l'écraser ?", vbYesNo, "ATTENTE REPONSE UTILISATEUR")
    If Reponse <> vbYes Then MsgBox "Pas d'archivage", vbCritical, "INFORMATION UTILISATEUR": Exit Sub
     
     Sheets("Planning").Range("FC12:FW" & Sheets("Planning").Range("FC65536").End(xlUp).Row).Copy
     Sheets("Archives").Select
     Sheets("Archives").Range("A" & Trouve.Row).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
          False, Transpose:=False
  
  Else
     
     Sheets("Planning").Range("FC12:FW" & Sheets("Planning").Range("FC65536").End(xlUp).Row).Copy
     Sheets("Archives").Select
     Range("A" & Sheets("Archives").Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
          False, Transpose:=False
 
  
  End If
  
  Application.CutCopyMode = False
  
 'Retour au planning
  Sheets("Planning").Select
  Range("FC11").Select
 End Sub

 

[Christian0258]

Re : Archiver une seule fois les mêmes données dates, si déjà archivées... MsgBox...

Re, le forum, Robert, camarchepas

Charmarbien.

Je te remercie infiniment, ça fonctionne parfaitement.

Bien à toi,
Christian