XL 2016 recopier des lignes automatiquement

[phil77]

bonjour a tous

je souhaiterais pouvoir copier automatiquement suivant la date des cellules spécifiques suivant des conditions vers une autre feuille
mais que lors de la copie vers la nouvelle que les données soit copies les lignes en dessous des autres

donc j ai une feuille
avec 3 fois une serie de 8 colonnes avec 20 lignes
et au dessus 3 dates
voir mon exemple

je souhaiterais que le 03-01-19 a 18h00
une macro s exécute de façon automatique
et aille copier vers la feuille 2 la ligne qui s arrette a la colonne G
vers la feuille 2 mais avec uniquement le contenu de certaines cellules
a condition que la ligne au niveau de la colonne F contienne "oui** oui"et
la colonne G sur admis"ou "arret"

ce qui donnerait dans mon exemple en feuille 2 a 18h00

date nom adresse voiture preteeet paye camion

03-01-19 utilisateur 2 nom 2 oui ** oui admis
03-01-19 utilisateur 3 nom 3 oui ** oui arret
03-01-19 utilisateur 6 nom 6 oui ** oui arret
03-01-19 utilisateur 14 nom 14 oui ** oui admis
04-01-1 utilisateur 17 nom 17 oui ** oui admis

puis le 04/01/13 a 18h00 on refait pareil mais avec les colonnes de i a O
que l on vient ajouter a la suite de la feuille 2 sous les autres


un tout grand merci pour l aide

 

[job75]

Bonjour phil77, le forum,

Private Sub Worksheet_Activate()
Dim a(), cel As Range, tablo, dat As Date, n&, i&
ReDim a(1 To Rows.Count, 1 To 5)
Set cel = Feuil1.[A1] 'CodeName de la feuille
Do
    tablo = cel.CurrentRegion.Resize(, 7) 'matrice, plus rapide
    dat = cel
    For i = 3 To UBound(tablo)
        If Replace(tablo(i, 6), " ", "") = "oui**oui" And (Trim(tablo(i, 7)) = "admis" Or Trim(tablo(i, 7)) = "arret") Then
            n = n + 1
            a(n, 1) = dat
            a(n, 2) = tablo(i, 1)
            a(n, 3) = tablo(i, 3)
            a(n, 4) = tablo(i, 6)
            a(n, 5) = tablo(i, 7)
        End If
    Next
    Set cel = cel(1, 9)
Loop While IsDate(cel)
If n Then [A2].Resize(n, 5) = a
Range("A" & n + 2 & ":E" & Rows.Count).ClearContents 'RAZ en dessous
End Sub

A+

 

[phil77]

bonjour job75

un grand merci pour le classeur et le code
mais y a t il moyen pour que cela se fasse de façon automatique
donc pour que quand on arrive a la date du jour a 18h00 que les lignes soient automatiquement copies en feuille 2
par exemple pour que ce jour a 18h00 ca soit les donnees de ce jour qui soient sauvegarder
demain le 03/01/19 que ce soient les lignes de ce jour qui soient ajoutees sur la feuille 2 a 18h00
et ainsi de suite

 

[job75]

Re,

Dans ThisWorkbook :

Private Sub Workbook_Open()
Application.OnTime TimeValue("18:00"), "MAJ"
End Sub

Dans Module1 :

Private Sub MAJ()
Dim cel As Range, tablo, a(), dat As Date, n&, i&
Set cel = Feuil1.Rows(1).Find(Date, , xlValues, xlWhole) 'CodeName de la feuille
If cel Is Nothing Then Exit Sub
tablo = cel.CurrentRegion.Resize(, 7) 'matrice, plus rapide
ReDim a(1 To UBound(tablo), 1 To 5)
dat = cel
For i = 3 To UBound(tablo)
    If Replace(tablo(i, 6), " ", "") = "oui**oui" And (Trim(tablo(i, 7)) = "admis" Or Trim(tablo(i, 7)) = "arret") Then
        n = n + 1
        a(n, 1) = dat
        a(n, 2) = tablo(i, 1)
        a(n, 3) = tablo(i, 3)
        a(n, 4) = tablo(i, 6)
        a(n, 5) = tablo(i, 7)
    End If
Next
With Feuil2 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Range("A" & .Rows.Count).End(xlUp)(2).Resize(n, 5) = a
    .Activate 'facultatif
    MsgBox "'" & .Name & "' mise à jour..."
End With
End Sub

Fichier (2).

A+

 

[phil77]

bonsoir
un grand merci pour le fichier
mais cela ne fonctionne pas
je viens d essayer en modifiant l heure sur 00:07 dans le fichier ThisWorkbook
mais rien ne s est passe
voila j ai refais un essai mais apres avoir modifier j ai ferme excel et je l ai ouvert cela a l air de fonctionner
je fais des essais
encore merci
bonne nuit

 

[job75]

Bonjour le forum,

voila j ai refais un essai mais apres avoir modifier j ai ferme excel et je l ai ouvert cela a l air de fonctionner

Bien sûr puisque cela lance la macro Workbook_Open...

 

[phil77]

bonjour job75
un tout grand merci je vais essayer cela la semaine prochaine
encore mille fois merci

 

[phil77]

bonjour job75

j ai ajouter des colonnes pour y mettre plus de jour
et j ai ensuite lancer excel durant le week end
mais les sauvegardes ne se sont pas effectue ?
es ce normal ?
merci de l aide

 

[job75]

Bonjour phil77,

j ai ajouter des colonnes pour y mettre plus de jour
et j ai ensuite lancer excel durant le week end
mais les sauvegardes ne se sont pas effectue ?
es ce normal ?

C'est toujours le tableau de la date du jour qui est traité à l'heure indiquée.

A+

 

[phil77]

merci pour la reponse
voici ce que j ai fait j ai donc copier coller les 3 séries de colonnes pour ajouter 3 jours
ce qui me fait 6 jours
et vendredi j ai lancer le classeur avant de partir
et ce lundi matin je m aperçois qu il n y a eu que vendredi de sauvegarder ...

 

[job75]

Je pense que quand l'ordi est en veille la macro MAJ ne s'exécute pas, était-ce le cas ?

 

[phil77]

oui le pc etait en veille , enfin presque puisque quand je bouge la souris je revois le classeur directement

 

[job75]

Donc le classeur était en veille, mais dès la sortie de veille aujourd'hui lundi la macro en attente s'est déclenchée.

 

[phil77]

merci pour la réponse
je vais donc faire des essais car ce lundi en fait des que j ai vu que cela n avait pas fonctionne j ai ferme le classeur
merci pour l intervention