Microsoft 365 Archivage automatique sous condition (Macro)

HugoLaChips · 8 Avril 2024

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.

wDog66 · 8 Avril 2024

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 · 8 Avril 2024

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+

HugoLaChips · 9 Avril 2024

Bonjour,

Merci beaucoup pour le coup de main, j'apprécie !

Je pars de cette base qui convient très bien ! Merci

Microsoft 365 Archivage automatique sous condition (Macro)

HugoLaChips

XLDnaute Nouveau

Pièces jointes

wDog66

wDog66

XLDnaute Occasionnel

HugoLaChips

XLDnaute Nouveau

Discussions similaires