Microsoft 365 Archivage automatique sous condition (Macro)

HugoLaChips

XLDnaute Nouveau
Bonjour à tous,
Je suis confronté à une volonté de créer un archivage automatique mais je n'arrive pas à 100% à le faire.

L'idée: J'ai un tableau qui rescence des soucis sur des pièces. Des ajouts peuvent se faire au fur et à mesure dans celui-ci (IMPORTANT).
Il a y une colonne "Traité ?". J'aimerais arriver à faire une macro qui vienne m'archiver sur une seconde feuille les lignes où il y a le "Oui" de la colonne "Traité ?"
COmme ça on peut archiver au fur et mesure dès l'on a traité notre souci.

J'avais une vague idée d'enregistrer une macro: Selection groupée des ligne du tableau remplie (CTRL+ MAJ+ BAS+DROITE) copier puis coller sur une autre feuille ("Archives") mais la Condition Oui ou Non ne s'applique pas dans cette manip. Je suis pas très bon pour créer une macro...

Merci d'avance pour vos lumières, car je souhaite réellement comprendre le fonctionnement pour que je puisse être capable derrière de réadapter sur un autre type de "projet" ce genre de macro.
 

Pièces jointes

  • KIT archivages.xlsx
    11.9 KB · Affichages: 5
Solution
Bonjour HugoLaChips,

Voici un code qui devrait faire l'affaire,
à vous de voir comment vous voulez le lancer (bouton ou évènement) ;)

VB:
Sub AchivageTraité()
  Dim ShtA As Worksheet, lRow As Long, nRowA As Long
  Set ShtA = ThisWorkbook.Sheets("Archivage")
  With ThisWorkbook.Sheets("KIT 15")
    lRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("$A$2:$F$" & lRow).AutoFilter Field:=6, Criteria1:="Oui"
    .Rows("3:" & lRow).Copy
    nRowA = ShtA.Range("A" & Rows.Count).End(xlUp).Row
    ShtA.Range("A" & nRowA).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    .Rows("3:" & lRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    Application.CutCopyMode = False...

wDog66

XLDnaute Occasionnel
Bonjour HugoLaChips,

Voici un code qui devrait faire l'affaire,
à vous de voir comment vous voulez le lancer (bouton ou évènement) ;)

VB:
Sub AchivageTraité()
  Dim ShtA As Worksheet, lRow As Long, nRowA As Long
  Set ShtA = ThisWorkbook.Sheets("Archivage")
  With ThisWorkbook.Sheets("KIT 15")
    lRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("$A$2:$F$" & lRow).AutoFilter Field:=6, Criteria1:="Oui"
    .Rows("3:" & lRow).Copy
    nRowA = ShtA.Range("A" & Rows.Count).End(xlUp).Row
    ShtA.Range("A" & nRowA).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    .Rows("3:" & lRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    Application.CutCopyMode = False
    .Range("$A$2:$F$12").AutoFilter Field:=6
  End With
End Sub

A+
 

Discussions similaires

Réponses
9
Affichages
511
Réponses
3
Affichages
791

Statistiques des forums

Discussions
315 126
Messages
2 116 492
Membres
112 763
dernier inscrit
issam2020