Mettre à jour un tableau

Bonjour,

J’aurais besoin de mettre à jour un tableau.

Dans le fichier il y a feuille « Tableau », je cherche à faire une macro, qui prendrait le chiffre de la colonne « BA », elle regarde dans les feuilles de match (colonne « BA ») pour trouver la même chiffre et mettre à jour les 3 cellules d’à côté. (si c’est possible en cellule « BC, x » et « BD, x » sont rempli ne rein toucher).

Merci de votre aide

Bonjour

humadome a écrit :

...qui prendrait le chiffre de la colonne « BA »,

Bye !

Normal, je me suis trompé de fichier

Bonjour,

Voici ce que voudrait que face la macro en détail.

Sur la feuille « Tableau »

1/ rechercher la 1ere case vide dans la colonne « BC » ou « BD »

2/récupérer ne nombre de la cellule en « BA »

3/ rechercher dans les feuilles de match colonne « BA » pour trouver le même nombre

4/copier les cellules « BC » et « BD » de la feuille de match sur la feuille « tableau »

5/passer à la ligne suivante jusqu’à que la cellule « BA » soit vide

humadome a écrit :

3/ rechercher dans les feuilles de match colonne « BA » pour trouver le même nombre

Où doit-on chercher ?

5/passer à la ligne suivante jusqu’à que la cellule « BA » soit vide

Bye !

Bonjour gmb,

Pour répondre à tes questions

1er/ Les feuilles de match sont toutes les feuilles avec leur nom écrit en majuscule.

C’est pour cela qu’il faut intégrer cet parti de macro :

crtf = -1

For Each Ws In Worksheets 'on établit la liste des feuilles

D = Mid(Ws.Name, 2, 1)

If D >= "A" And D <= "Z" Then 'nom en majuscule (2ème lettre)

ctrf = ctrf + 1

ReDim Preserve Listefeuilles(ctrf)

Listefeuilles(ctrf) = Ws.Name

End If

Next Ws

5/passer à la ligne suivante jusqu’à que la cellule « BA » soit vide

2ème/Sur la ligne suivante sur la feuille « tableau ». on vérifie si cellule est vide dans la colonne « BC » ou « BD

Bonjour,

suite à ta demande en MP, une proposition (vite faite)

Sub MàJ()
'
' MàJ Macro
'
    Dim C As Range, i As Long, Sh As Worksheet, Plage As Range, Ligne As Variant, listefeuilles(), ctrf

    ctrf = -1
    For Each Ws In ThisWorkbook.Worksheets    'on établit la liste des feuilles
        D = Mid(Ws.Name, 2, 1)
        If D >= "A" And D <= "Z" Then    'nom en majuscule => feuille à numéroter
            ctrf = ctrf + 1
            ReDim Preserve listefeuilles(ctrf)
            listefeuilles(ctrf) = Ws.Name
        End If
    Next Ws

    For Each wsn In listefeuilles
        Set Ws = Sheets(wsn)
        dl = Ws.Cells(Rows.Count, "BA").End(xlUp).Row
        Set plm = Ws.Range("BA1").Resize(dl)
        With Sheets("Tableau")
            Set Plage = .Range("BA2", .Cells(.Rows.Count, "BA").End(xlUp))
            For Each C In Plage
                Ligne = ""
                On Error Resume Next
                Ligne = Application.WorksheetFunction.Match(C.Value, plm, 0)
                If Err = 0 Then
                    On Error GoTo 0
                    If IsNumeric(Ligne) Then
                        C.Offset(, 2).Value = Ws.Cells(Ligne, "BC").Value
                        C.Offset(, 3).Value = Ws.Cells(Ligne, "BD").Value
                    End If
                End If
            Next C
        End With

    Next wsn
    '
End Sub

Bonjour h2so4

Pour une proposition (vite faite) , elle fonctionne parfaitement.

Je te remercie.