XL 2021 Modification et remplacer l'origine

[achraf26]

Bonjour,
j'ai crée un tableau nommé résumé dont il y'a les informations recherché du tableau(x) original(aux), au final je voudrais savoir quel fonction ou vba qui me permet de modifier si nécessaire des informations affiché et les remplacer automatiquement à la ligne correspondante du tableau original.
Merci infiniment.

 

[job75]

Bonjour achraf26,

Vous n'avez pas eu de réponse parce que le fichier déposé au post #14 est incohérent.

Pourquoi ne pas utiliser le code que j'ai donné au post #13 ?

A+

 

[achraf26]

Bonjour achraf26,

Vous n'avez pas eu de réponse parce que le fichier déposé au post #14 est incohérent.

Pourquoi ne pas utiliser le code que j'ai donné au post #13 ?

A+

Bonjour Job,
merci pour votre réponse, j'ai pris le code de post 13, je l'ai appliqué ::
conclusion : les lignes recherché se met à partir de la 2é ligne du tableau, et lors d'une modification aucun changement n'est fais.
Merci.

Sub MettreAjour()
Dim Lig&, Numéro, LO As ListObject, NL&, L&, C%
Lig = 8
While Cells(Lig, "AN") <> ""
    Numéro = Cells(Lig, "AN")
    For Each LO In ActiveSheet.ListObjects
        NL = LO.Range.Rows.Count
        For L = 2 To NL
            If LO.Range(L, 1) = Numéro Then
                For C = 1 To 10
                    LO.Range(L, C) = Cells(Lig, C + 39)
                Next C
            End If
    Next L, LO
    Lig = Lig + 1
Wend
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$AG$3" Then Exit Sub
    Dim dest As Range, LO As ListObject
    Target.Select
    Set dest = [AN8]
    Application.ScreenUpdating = False
    dest.CurrentRegion.Offset(1).ClearContents 'RAZ
    For Each LO In Me.ListObjects 'traite tous les tableaux structurés
        With LO.Range
            .AutoFilter 7, Target
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy
            dest.Offset(dest.CurrentRegion.Rows.Count).PasteSpecial xlPasteValues
            .AutoFilter 7
        End With
    Next LO
    Target.Select
End Sub

 

[sylvanu]

Re,
2 erreurs, AN et non BU, et Tableau4 et non Tableau1 :

Sub MettreAjour()
Dim Lig&, L&, NL&, C%, Numéro
Lig = 8
While Cells(Lig, "AN") <> ""
    Numéro = Cells(Lig, "AN")                               ' AN et non BU
    NL = [Tableau4].ListObject.ListRows.Count
    For L = 1 To NL
        If [Tableau4].Item(L, 1) = Numéro Then
            For C = 1 To 14
                [Tableau4].Item(L, C) = Cells(Lig, C + 39)  ' Tableau4 et non Tableau1
            Next C
        End If
    Next L
    Lig = Lig + 1
Wend
End Sub

 

[job75]

Sur le fichier du post #17 la ligne AN6:AW6 n'était pas vide !!!

J'ai complété les lignes d'en-têtes des tableaux.

Les macros :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$AG$3" Then Exit Sub
    Dim dest As Range, LO As ListObject
    Target.Select
    Set dest = [AN7]
    Application.ScreenUpdating = False
    dest.CurrentRegion.Offset(1).ClearContents 'RAZ
    For Each LO In Me.ListObjects 'traite tous les tableaux structurés
        With LO.Range
            .AutoFilter 7, Target
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy
            dest.Offset(dest.CurrentRegion.Rows.Count).PasteSpecial xlPasteValues
            .AutoFilter 7
        End With
    Next LO
    Target.Select
End Sub

Sub MettreAjour()
Dim Lig&, Numéro, LO As ListObject, NL&, L&, C%
Lig = 8
While Cells(Lig, "AQ") <> ""
    Numéro = Cells(Lig, "AQ")
    For Each LO In ActiveSheet.ListObjects
        NL = LO.Range.Rows.Count
        For L = 2 To NL
            If LO.Range(L, 4) = Numéro Then
                For C = 1 To 10
                    LO.Range(L, C) = Cells(Lig, C + 39)
                Next C
            End If
    Next L, LO
    Lig = Lig + 1
Wend
End Sub