Copier coller en valeur si date d’aujourd’hui et autre condition

[lematou]

Bonjour et bonne année à tout le forum

J’inscris des listes de données ligne par ligne, l’une sous les autres. Avec en colonne A le statut, en B le nom....etc
et en colonne T la date du jour (CTRL+
Je voudrais copier coller en valeur sur une autre feuille toutes les lignes remplies suivant deux conditions :
1) le statut colonne A ( MA ou LO)
2) La date du jour colonne E
Si Colonne A contient MA et Colonne E contient date d’aujourd’hui, alors copier coller vers feuille Publi_MA
Si Colonne A contient LO et Colonne E contient date d’aujourd’hui, alors copier coller vers feuille Publi_LO
Afin de faire deux publipostages différents

J’ai regardé dans le forum plusieurs cas, mais je n’ai pas trouvé mon bonheur.
Je sais utiliser l’exécuteur de macro pour copier / coller en valeur sur une autre feuille mais je ne sais pas lui dire :
Colle dans la feuille « Publi_MA » les lignes qui ont MA en colonne A et la date du jour en colonne E et seulement celles-là ????
Idem pour LO
Et surtout mets les lignes d’en-tête aussi !!!
Je joins un petit fichier pour mieux me faire comprendre.
Si quelqu’un a une idée en VBA 2003. ??? Merci

 

[Paf]

Re : Copier coller en valeur si date d’aujourd’hui et autre condition

Bonjour,

le code ci dessous répond presque aux besoins:

Sub Macro1()

Dim DerLig As Integer, DerLigMA As Integer, DerLigLO As Integer, i As Integer, j As Integer
Dim TabMA(), TabLO(), IndMA As Integer, IndLO As Integer

With Worksheets("Inscriptions")
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim TabMA(DerLig, 5)
    ReDim TabLO(DerLig, 5)
    For i = 2 To DerLig ' pour chaque ligne d'inscription
        If .Cells(i, 1) = "MA" And .Cells(i, 5) = Date Then ' si col A = MA et col E date du jour
            For j = 0 To 4              'mise de la ligne dans un tableau
                TabMA(IndMA, j) = .Cells(i, j + 1)
            Next
            IndMA = IndMA + 1
        End If
        If .Cells(i, 1) = "LO" And .Cells(i, 5) = Date Then
            For j = 0 To 4
                TabLO(IndLO, j) = .Cells(i, j + 1)
            Next
            IndLO = IndLO + 1
        End If
    Next
End With
'**** transfert des tableaux dans les feuilles respectives
With Worksheets("Publi_MA")
    DerLigMA = .Range("A" & Rows.Count).End(xlUp).Row
    .Cells(DerLigMA + 1, 1).Resize(UBound(TabMA, 1), UBound(TabMA, 2)).Value = TabMA
End With
With Worksheets("Publi_LO")
    DerLigLO = .Range("A" & Rows.Count).End(xlUp).Row
    .Cells(DerLigLO + 1, 1).Resize(UBound(TabLO, 1), UBound(TabLO, 2)).Value = TabLO
End With

End Sub

au lancement de la macro les lignes MA ou LO viennent se rajouter aux données existantes dans les feuilles MA ou LO. Les lignes d'entête de ces feuilles ne sont pas copiées, mais si elles sont déjà en place ....

A+

 

[lematou]

Re : Copier coller en valeur si date d’aujourd’hui et autre condition

Merci Paf
merci beucoup
Je bricolais avec des macros très longues mais je ne savais pas utiliser la notin de tableaux
Ta macro marche très bien. mais je dois à présent la comprendre!!!
Il faut que je rajoute de "vider" les feuilles Ma et LO avant de la lancer (ça je sais faire).
Et que je rajoute aussi la ligne d'en-tête dans les deux feuilles avant la macro (je sais faire aussi)
Mais j'ai testé en mettant l'horloge à dimanche 05/01/2014 et en mettant les lignes d'inscriptions au même jour ça marche
impec. La seule chose que je ne décèle pas du tout dans le code c'est comment tu fias pour trouver la date du jour???
Si tu peux m'expliquer?
Est-ce que je peux donner une date différente??

 

[Paf]

Re : Copier coller en valeur si date d’aujourd’hui et autre condition

Re,
on pourrait s'affranchir des tableaux et copier directement ligne par ligne dans les feuilles concernées, mais avec les tableaux c'est plus rapide (surtout pour de grandes quantités de lignes à traiter) et pour la recopie, il n'y a pas besoin de calculer la ligne où copier.

la date du jour est donnée par l'instruction VBA : Date dans les tests:

If .Cells(i, 1) = "MA" And .Cells(i, 5) = Date Then

If .Cells(i, 1) = "LO" And .Cells(i, 5) = Date Then

pour une date différente, mettre la date en dur dans le code:

..... .Cells(i, 5) = "21/12/2013" then

ou encore mieux, utiliser une inputbox;
juste avant With Worksheets("Inscriptions") mettre le code:

MaDate = CDate(InputBox("entrez la date"))

et modifier les deux lignes de test:

If .Cells(i, 1) = "MA" And .Cells(i, 5) = MaDate Then

If .Cells(i, 1) = "LO" And .Cells(i, 5) = MaDate Then

A+

 

[Paf]

Re : Copier coller en valeur si date d’aujourd’hui et autre condition

code initial modifié pour vider les feuilles et mettre les titres:

With Worksheets("Publi_MA")
    .Range("A1").CurrentRegion.ClearContents    ' *** efface les cellules utilisées autour de A1
    Worksheets("Inscriptions").Range("A1:E1").Copy .Range("A1")  '*** copie de la ligne de titre
    DerLigMA = .Range("A" & Rows.Count).End(xlUp).Row
    .Cells(DerLigMA + 1, 1).Resize(UBound(TabMA, 1), UBound(TabMA, 2)).Value = TabMA
End With
With Worksheets("Publi_LO")
    .Range("A1").CurrentRegion.ClearContents
    Worksheets("Inscriptions").Range("A1:E1").Copy .Range("A1")
    DerLigLO = .Range("A" & Rows.Count).End(xlUp).Row
    .Cells(DerLigLO + 1, 1).Resize(UBound(TabLO, 1), UBound(TabLO, 2)).Value = TabLO
End With

Bonne suite

 

[lematou]

Re : Copier coller en valeur si date d’aujourd’hui et autre condition

Merci Paf
J'ai bien regardé et j'ai compris.
J'ai un peu de mal pour piger les tableaux mais ça va venir.
De toutes façons ça fonctionne très bien.
Je te remercie beucoup.
A bientôt