Macro pour archiver avec condition

[phil92350]

Bonjour à tous,

Il y a bien longtemps que je n'ai pas posté sur le forum....
Aujourd'hui même si j'ai progressé dans le VBA, j'ai besoin à nouveau de l'aide de certain crack du VBA !

Je m'explique

J'ai un fichier avec 2 onglets : TDB et Archive TDB
Dans ces deux tableaux 6 colonnes avec des renseignement divers tel que nom, fonction etc....
J'aimerai que lorsque toutes les cellules de la colonne "I" (date de sortie) de la feuille "TDB" contenant une date, toute les lignes correspondantes soient coupées et coller dans la feuille "archive TDB".

Merci pour votre aide.
Après j'ai l'intension de créer un formulaire par une userform pour faciliter les saisies, mais avant je vais étudier les réponses et en comprendre le sens des codes.

Bonne journée

 

[Robert]

Re : Macro pour archiver avec condition

Bonjour Phil, bonjour le forum,

je te propose la macro suivante (je l'ai placé directement sur le bouton par habitude...) :

Private Sub CommandButton3_Click() 'bouton "arvhivermonotdb"
Dim oc As Worksheet 'déclare la variable oc (Onglet Cible)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set oc = Sheets("Archive TDB") 'définit l'onglet cible
For Each cel In Range("I4:I114") 'boucle sur toutes les cellules cel de la plage I4:I114
    If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
        Set dest = oc.Range("D65536").End(xlUp).Offset(1, 0) 'définit la destination
        With Range(Cells(cel.Row, 4), Cells(cel.Row, 9)) 'prend en compte la ligne correspondante
            .Copy 'copie la ligne
            dest.PasteSpecial (xlPasteValues) 'colle les valeurs
            .ClearContents 'efface le contenu
        End With 'fin de la prise en compte de la ligne correspondante
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
End Sub

 

[phil92350]

Re : Macro pour archiver avec condition

Merci Robert,

J'ai bien noter les lignes sans la première que j'ai copié dans la macro et cela fonctionne. Est ce plus avantageux de copier les lignes directement sur le bouton ?

Merci encore et bonne journée mainteant je potasse !!!

phil

 

[Robert]

Re : Macro pour archiver avec condition

Bonjour Phil, bonjour le forum,

Est ce plus avantageux de copier les lignes directement sur le bouton ?

Franchement je n'en sais rien ! Moi ça me parait surtout plus simple mais plus efficace ??? C'est surtout que j'ai l'habitude de faire comme ça.

 

[phil92350]

Re : Macro pour archiver avec condition

Merci encore robert,

Je suis resté sur tes codes toute la journée !
Comme quoi je ne me contente pas de demander et de copier. Il faut un peu gamberger!
Mon fichier maintenant s'appelle "gestion des badges"
Mais voila tu peux voir que j'ai pas trop mal "bosser" mais je bloque de nouveau sur un point.
Dans l'onglet "BDD", dans la colonne "O" je peux mettre plusieurs états et j'aimerai pouvoir copier en archive les lignes qui dans la colonne "O" contiennent "PERDUE" ou "RENDUE" lorsque je clique sur la macro "ARCHIVAGE"

Merci pour l'entraide et bonne soirée à tous.🙂

Phil

 

[Robert]

Re : Macro pour archiver avec condition

Bonjour Phil, bonjour le forum,

Bravo tu as bien adapé à ce nouveau fichier... Le code modifié en rouge :

Sub mettreenarchive()
Dim oc As Worksheet 'déclare la variable oc (Onglet Cible)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set oc = Sheets("Archive") 'définit l'onglet cible.
For Each cel In Range("O3:O202") 'boucle sur toutes les cellules cel de la plage O3:O202.
                                'C'est par cette plage de cellule que la condition d'archivage est définie.
    If cel.Value = "PERDUE" [COLOR=red]Or cel.Value = "RENDUE" [/COLOR]Then 'condition : si la cellule contient PERDUE
        Set dest = oc.Range("C65536").End(xlUp).Offset(1, 0) 'définit la destination
        With Range(Cells(cel.Row, 4), Cells(cel.Row, 14)) 'prend en compte la ligne correspondante
            .Copy 'copie la ligne
            dest.PasteSpecial (xlPasteValues) 'colle les valeurs
            .ClearContents 'efface le contenu
        End With 'fin de la prise en compte de la ligne correspondante
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
 
End Sub