transposer automatiquement des données d'une feuille 1 dans un tableau en feuille 2

[WENSCH]

Bonjour,

Je suis un débutant sur excel et nouveau sur le forum. Bien que n'étant pas un passionné, je fais appel a vous afin de savoir si vous pourriez me venir en aide pour mener a bien un projet.

J'ai fait dans un classeur sur une feuille 1 excel un arbre généalogique.

Pour chaque individu, les données sont comprises dans un carré de deux colonnes de large de 6 lignes de hauteur. Je souhaiterais transposer les données contenues dans chacun de ces carrés dans un tableau sur une feuille 2, en transposant les données de la verticale à l'horizontale, et ce de manière automatique.

Mon objectif est que chaque individu rentré dans l'arbre soit automatiquement repertorié dans le tableau statistique.

Je vous laisse mon fichier excel pour mieux comprendre

Si quelqu'un pouvait m'aider ce serait merveilleux !


je vous remercie par avance !

 

[ROGER2327]

Re : transposer automatiquement des données d'une feuille 1 dans un tableau en feuill

Bonjour WENSCH

Essayez la procédure suivante :​

Sub tata()
Dim i&, j&, k&, fl As Worksheet, plg As Range, v(7)
    k = 1
    Set fl = Worksheets("Tableau Statistiques")
    With fl.Range("A2"): fl.Range(.Cells, .End(xlDown).End(xlToRight)).Clear: End With
    With Worksheets("Arbre")
        For i = 1 To 600 'À adapter.
            On Error GoTo Manque
            Set plg = .Cells.Find(What:=CStr(i), LookIn:=xlValues, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext)
            For j = 0 To 3: v(j) = plg.Offset(j).Value: Next
            v(4) = plg.Offset(3, 1).Value
            v(5) = plg.Offset(4).Value
            v(6) = plg.Offset(4, 1).Value
            v(7) = plg.Offset(5).Value
            k = k + 1
            fl.Cells(k, 1).Resize(1, 8).Value = v
R:      Next
    End With
Exit Sub
Manque:
    Resume R
End Sub

ROGER2327
#5933

Jeudi 26 Merdre 139 (Sainte Barbaque, naïade - fête Suprême Quarte)
24 Prairial An CCXX, 0,2130h - caille-lait
2012-W24-2T00:30:40Z

 

[WENSCH]

Re : transposer automatiquement des données d'une feuille 1 dans un tableau en feuill

Merci beaucoup, c'est exactement ce que je voulais !!!

Une dernière petite question : comment je peux faire si je veux mettre une donnée supplémentaire sur chaque individu ? Que dois je modifier dans le CODE VBA ?

Merci encore en tout cas !

 

[ROGER2327]

Re : transposer automatiquement des données d'une feuille 1 dans un tableau en feuill

Re...

(...)
comment je peux faire si je veux mettre une donnée supplémentaire sur chaque individu ? Que dois je modifier dans le CODE VBA ?
(...)

Les données sont temporairement placées dans un vecteur-ligne à huit composantes v.
Ce vecteur est déclaré dans le code par Dim v(7).
On recherche SOSA par la ligne

Set plg = .Cells.Find(What:=CStr(i), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

plg fait alors référence à la cellule dans laquelle on l'a trouvé.
Les lignes de code

For j = 0 To 3: v(j) = plg.Offset(j).Value: Next
            v(4) = plg.Offset(3, 1).Value
            v(5) = plg.Offset(4).Value
            v(6) = plg.Offset(4, 1).Value
            v(7) = plg.Offset(5).Value

placent ensuite les données correspondantes dans le vecteur v selon la disposition :
v(0)=SOSA ; v(1)=NOM ; v(2)=PRENOM ; v(3)=DATE NAISSANCE ; v(4)=LIEU ; v(5)=DATE DECES ; v(6)=LIEU ; v(7)=profession.

Si vous voulez utiliser une donnée supplémentaire, il vous faut déclarer le vecteur v avec une composante de plus par

Dim v(8)

puis compléter le code par une ligne

v(8) = plg.Offset(x, y).Value

où x et y désignent le décalage de ligne et de colonne de la nouvelle donnée par rapport à la cellule plg.

Pour terminer, modifier la ligne

            fl.Cells(k, 1).Resize(1, 8).Value = v

en

            fl.Cells(k, 1).Resize(1, 9).Value = v

Voilà...
​

ROGER2327
#5940

Vendredi 27 Merdre 139 (Saints Courts et Longs, gendarmes - fête Suprême Quarte)
25 Prairial An CCXX, 0,2317h - tanche
2012-W24-3T00:33:22Z