XL 2021 Modification et remplacer l'origine

  • Initiateur de la discussion Initiateur de la discussion achraf26
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

achraf26

XLDnaute Occasionnel
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.
 

Pièces jointes

Solution
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 :
VB:
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...
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.

VB:
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


Code:
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
 

Pièces jointes

Re,
2 erreurs, AN et non BU, et Tableau4 et non Tableau1 :
VB:
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
 

Pièces jointes

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 :
VB:
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
VB:
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour