VBA modification code

Bonjour

Je souhaiterais une modification du code .

Explication sur le fichier joint.

Merci d'avance

Nonno

4essai.xlsm (26.37 Ko)

Bonjour

Ci joint ma solution

5essai.xlsm (26.20 Ko)

A+ François

Bonjour Nonno

Comme vous utilisez un TS (Tableau Structuré) autant s'en servir
Voici un code qui peut convenir

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ts As ListObject
  Dim Cel As Range, NbCol As Long
  ' Si aucune valeur saisie on sort
  If Target.Value = "" Then Exit Sub
  ' Si modification dans la cellule voulue
  If Target.Address = "$C$14" Then
    ' Activer la feuille
    Sheets("Feuil3").Activate
    ' Définir le Tableau Structuré
    Set Ts = Sheets("Feuil3").ListObjects("Tableau1")
    NbCol = Ts.Range.Columns.Count
    Set Cel = Ts.DataBodyRange.Columns(1).Find(Target.Value, LookAt:=xlPart)
    If Not Cel Is Nothing Then
      Ts.DataBodyRange.Range("A" & Cel.Row).Resize(1, NbCol).Select
    Else
      MsgBox "Donnée introuvable.", 16
    End If
  End If
  ' Effacer la variable objet pour libérer la mémoire
  Set Ts = Nothing
End Sub

A+

Edit : bonjour fanfan38

Bonjour à tous,
Une petite variante.
Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, lo As ListObject, rw
    If Target.Address = "$C$14" And Not IsEmpty(Target) Then
        Set ws = Worksheets("Feuil3")
        Set lo = ws.Range("Tableau1").ListObject
        rw = Application.Match(Target.Value, lo.ListColumns(1).DataBodyRange, 0)
        If IsError(rw) Then
            MsgBox "Donnée introuvable.", 64
        Else
            ws.Activate
            lo.ListRows(rw).Range.Select
        End If
    End If
End Sub
Formidable! 3 solutions (Abondance de biens ne nuit pas!) Alors merci à vous trois Bon Week end Nonno
Rechercher des sujets similaires à "vba modification code"