Résolu, Trouver contacts via macro

BOISGONTIER à dit:

Bonjour,

Cf pj

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then
    Sheets("Feuil1").Range("A1:F10000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Feuil1").Range("H1:H2"), CopyToRange:=Range("A4:F4") 
  End If
End Sub

JB

Cliquez pour agrandir...

BOISGONTIER à dit:

Voir PJ

JB

Cliquez pour agrandir...

Isab à dit:

Bonjour

peut-être comme ceci ( fichier joint)

Code:

Sub Trouv()
Dim MaZone As Range, DerLg As Long, LeNom As String
LeNom = Sheets("feuil2").Range("B2").Value
If Sheets("feuil2").Range("B2") Is Nothing Then
Exit Sub
Else
DerLg = Cells.Find("*", , , , xlByColumns, xlPrevious).Row
Set MaZone = Sheets("feuil1").Range("A1:B" & DerLg).Find(what:=LeNom)
  If MaZone Is Nothing Then
  MsgBox Text & " est introuvale !!!!", vbCritical
  Else
  DerLg = Sheets("feuil2").Cells.Find("*", , , , xlByColumns, xlPrevious).Row
  MaZone.EntireRow.Copy Sheets("feuil2").Range("A" & DerLg + 1)
  End If
End If
End Sub

Bonne journée

Cliquez pour agrandir...