Transposer automatiquement les données d'un tableau à l'autr

13vba-transpo.xlsm (27.64 Ko)

Bonjour à tous,

Je suis débutant en programmation VBA, et je dois dans mon entreprise modifier une database (qui est mise à jour chaque jour) pour la rendre plus simple.

J'aurai besoin de vos conseils, la base de donné ressemble au 1er tableau sur le fichier excel.

Et elle doit être transformée de manière a adopter le format du second tableau.

Il faudrait aussi que je garde un lien entre le premier et le second tableau, de sorte à lorsque je rentre des données dans le 1er tableau, elles se transposent directement sur le second

Sur ce fichier, je l'ai fait manuellement, or, j'ai besoin que cela soit automatique mais cela dépasse malheureusement mes compétences.

De plus, si je rajoute une colonne (ex: Jack) dans le tableau 1, il faudrait que dans le tableau 2 les données suivent.

Je n'ai pas tant l'impression que ca soit si compliqué que ca, mais je bloque complètement! J'espère que vous pourrez m'aider et que j'ai été assez clair!

Merci d'avance!

capture d ecran 2017 03 29 a 11 11 25 capture d ecran 2017 03 29 a 11 11 34

bonjour,

ta as une solution immédiate avec un tableau croisé dynamique.

Merci de ta réponse super rapide!

J'avais en effet pensé au tableau croisé dynamique, malheureusement mon boss veut impérativement une programmation VBA.

Afin de pouvoir utiliser le modèle de code pour toutes les autres databases.

Merci de ton aide!

bonjour,

une proposition

Sub aargh()
    Set outr = Sheets("feuil2").Range("E4") 'position du tableau de sortie à adapter
    Set wso = outr.Parent
    ocol = outr.Column
    olig = outr.Row
    Set inr = Sheets("feuil1").Range("C12") 'position du tableau d'entrée à adapter
    Set wsi = inr.Parent
    icol = inr.Column
    ilig = inr.Row + 1
    Set fyr = Rows(olig)
    While wsi.Cells(ilig, icol) <> ""
        Set c = fyr.Find(wsi.Cells(ilig, icol + 2), lookat:=xlWhole)
        If Not c Is Nothing Then
            Set l = wso.Columns(ocol + 1).Find(wsi.Cells(ilig, icol + 1), lookat:=xlWhole)
            If l Is Nothing Then
                olig = olig + 1
                wso.Cells(olig, ocol) = wsi.Cells(ilig, icol)
                wso.Cells(olig, ocol + 1) = wsi.Cells(ilig, icol + 1)
                wso.Cells(olig, ocol + 2) = wsi.Cells(ilig, icol + 3)
            Else
                wso.Cells(l.Row, c.Column) = wsi.Cells(ilig, icol + 3)
            End If
        Else
            MsgBox "year " & wsi.Cells(ilig, icol + 1) & "non trouvé"
        End If
        ilig = ilig + 1
    Wend
End Sub
Rechercher des sujets similaires à "transposer automatiquement donnees tableau autr"