XL 2010 Macro pour copier lignes

[angelis70]

Bonjour,

Je souhaiterais copier des lignes d'une feuille excel sur une autre sous certaines conditions. J'ai bien essayé de trouver, mais débutant en le VBA je galère.
Pour résumer, j'ai fait un fichier simplifié. En gros je souhaite que si dans la colonne B j'ai soit "dupont" soit "patrick", les lignes soient entièrement collées sur la feuille 2, sans ligne vide.
Quelqu'un pourrait-il m'aider ?

Merci d'avance

 

[mapomme]

Bonjour @angelis70, bienvenue sur XLD,

Voir dans le fichier joint.

• Le code est dans module1
• La constante LesNoms comporte les noms à retenir pour la copie. Les noms sont séparés par des virgules sans espace.
• Cliquez sur le bouton Hop ! sur la feuille "Feuil2"

Le code dans module1 :

Option Explicit

Const LesNoms = "Dupont,Patrick"

Sub copier()
Dim derlig, dercol, t, i&, j&, n&, ref, aux

   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(Rows.Count, "b").End(xlUp).Row
      dercol = .Cells(2, Columns.Count).End(xlToLeft).Column
      t = .Range(.Range("b2"), .Cells(derlig, dercol))
   End With

   ref = LCase("," & LesNoms & ","): n = 1
   For i = 2 To UBound(t)
      If InStr(ref, "," & LCase(t(i, 1)) & ",") > 0 Then
         n = n + 1
         For j = 1 To UBound(t, 2): t(n, j) = t(i, j): Next
      End If
   Next i

   With Sheets("Feuil2")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(Rows.Count, "b").End(xlUp).Row
      dercol = .Cells(2, Columns.Count).End(xlToLeft).Column
      .Range(.Range("b2"), .Cells(derlig, dercol)).ClearContents
      .Range("b2").Resize(n, UBound(t, 2)) = t
      .Select
   End With
End Sub

 

[angelis70]

C'est nickel ! Merci beaucoup !