Copier/coller avec une condition

[JoeZ1]

Bonjour,

Je me tourne vers vous pour m'aider pour la creation d'une macro pour mon fichier

Je vais essayer d'etre clair dans mes explications:
Tous les jours, je dois renseigner une base de donnee
En fin de journée, je souhaiterai l'archiver dans l'onglet "archive", mais je souhaiterai conserver que les lignes qui ont des cellules vertes( A savoir dans les colonnes personnel, il y a un code et une mise en forme conditionnelle)
De plus, il ne faut surtout pas ecraser l'archive de la vielle.
Tous les mois, je dois faire un bilan

Un grand merci de votre aide.

 

[vgendron]

Bonjour

Question:
Est ce que le fait d'avoir une (ou plusieurs) cases vertes dans les colonnes Personnel implique forcément d'avoir une case verte en colonne DTC ?
si oui, il suffirait de filtrer sur la colonne DTC et archiver les lignes filtrées..

 

[pierrejean]

Bonjour joeZ1

Un essai

 

[JoeZ1]

Bonjour

Question:
Est ce que le fait d'avoir une (ou plusieurs) cases vertes dans les colonnes Personnel implique forcément d'avoir une case verte en colonne DTC ?
si oui, il suffirait de filtrer sur la colonne DTC et archiver les lignes filtrées..

C'est completement independant. Mais je dois conserver mes infos

 

[JoeZ1]

Bonjour joeZ1

Un essai

Merci pour cette premiere version, c'est exactement le principe que je souhaite

Tous les jours, je dois creer ma base de donnee. Est il possible d'archivé à la suite?

 

[vgendron]

Hello @pierrejean
exactement la démarche que j'avais commencé. mais comme tu as été plus rapide..

du coup, je me suis permis de modifier ton code pour répondre au besoin de ne pas écraser la feuille Archives

Sub archive()
tablo = Sheets("Base de donnees").Range("A4:P" & Sheets("Base de donnees").Range("A" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
   For m = 7 To 14
       If tablo(n, m) = "X" Or tablo(n, 14) > 0.1 Then
          x = n + 3
          dico(x) = ""
       End If
   Next
Next
a = dico.keys
With Sheets("Archives")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    For n = LBound(a) To UBound(a)
        Sheets("Base de donnees").Rows(a(n)).Copy Destination:=.Rows(fin + 1)
        fin = fin + 1
    Next n
    .Activate
End With
End Sub

 

[JoeZ1]

C'est axactement ce que je recherche.
Mais bizarrement. Il y a que les deux premieres lignes qui vont dans les archives

 

[JoeZ1]

Hello @pierrejean
exactement la démarche que j'avais commencé. mais comme tu as été plus rapide..

du coup, je me suis permis de modifier ton code pour répondre au besoin de ne pas écraser la feuille Archives

Sub archive()
tablo = Sheets("Base de donnees").Range("A4:P" & Sheets("Base de donnees").Range("A" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
   For m = 7 To 14
       If tablo(n, m) = "X" Or tablo(n, 14) > 0.1 Then
          x = n + 3
          dico(x) = ""
       End If
   Next
Next
a = dico.keys
With Sheets("Archives")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    For n = LBound(a) To UBound(a)
        Sheets("Base de donnees").Rows(a(n)).Copy Destination:=.Rows(fin + 1)
        fin = fin + 1
    Next n
    .Activate
End With
End Sub

Merci pour votre efficacite et rapidité. Vous etes etes en train de me rendre un grand service.


C'est bon, il fonctionne tres bien. J'ai une erreur de Manip

Par contre, je souhaiterai que les jours suivant se mettent à la suite dans l'onglet "Archives"

 

[vgendron]

ar contre, je souhaiterai que les jours suivant se mettent à la suite dans l'onglet "Archives"

C'est déjà le cas il me semble. non?
ou alors, on ne se comprend pas sur le besoin

 

[JoeZ1]

Bonjour,

Ce matin, le fichier fonctionne tres bien.
Hier, j'avais d'enorme probleme avec le reseau. Ca fesait planter les PC

En grand merci pour votre aide et votre disponibilté