VBA copier coller selon critère

Bonjour

Je n'y arrive pas!

je joint un fichier

Merci

Nonno

4essai.xlsm (40.96 Ko)

Bonjour Nonno, le forum,

Un essai.....

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim tablo, tabloR(), k%, i

   tablo = Sheets("Archivage").Range("A1").CurrentRegion

  If Not Application.Intersect(Target, Range("E14")) Is Nothing Then
   Cancel = True
        k = 0
    For i = 1 To UBound(tablo, 1)
     If Right(tablo(i, 17), 7) = Right(Target.Value, 7) Then  'mois & année
      ReDim Preserve tabloR(1 To 4, 1 To k + 1)
       tabloR(1, 1 + k) = tablo(i, 3)
       tabloR(2, 1 + k) = tablo(i, 4)
       tabloR(3, 1 + k) = tablo(i, 9)
       tabloR(4, 1 + k) = tablo(i, 10)
        k = k + 1
     End If
    Next i
     Range("A21").CurrentRegion.Offset(1, 0).ClearContents
    On Error Resume Next
     Range("A22").Resize(UBound(tabloR, 2), 4) = Application.Transpose(tabloR)
  End If
End Sub
2essai-v1.xlsm (44.68 Ko)

Cordialement,

Merci XORSANKUKAI

Tu m'avais déjà donné la solution, mais je n'arrivai pas à l'adapter à mon fichier.

Maintenant c'est Nickel!

Merci encore (ce n'est pas la première fois que tu me viens en aide.)

Cordialement

Nonno

Re,

Merci pour ton retour,

Attention, ta formule en F18 ne donne pas toujours le bon résultat....(voir juin 19) puisque le critère retenu est la date en E14 et non le mois et l'année.

A tester pour que cela corresponde au nombre de lignes à afficher:

=SOMMEPROD((ANNEE(Tableau8[Colonne1])=ANNEE($E$14))*(MOIS(Tableau8[Colonne1])=MOIS($E$14)))
1essai-v2.xlsm (44.71 Ko)

Cordialement,

Ok

Merci encore

Bonne soirée

Nonno

Rechercher des sujets similaires à "vba copier coller critere"