Copier chaque valeur d'une colonne en une nouvelle ligne

Bonjour,

Ayant des connaissances en VB et en excel très limitée, j'ai besoin de votre aide.

Je souhaiterais créer une macro automatique qui réalise une copie de chaque valeur d'un tableau excel en une nouvelle ligne sur une autre feuille. Afin d'avoir une base de données "classique" qui me permettra d'analyser mes données via le logiciel Tableau BI.

Comme dans l'exemple ci-dessous, sachant que le tableau excel que j'utilise comporte bien plus de solutions et de pays, et qu'il est complété régulièrement.

Quelle est la méthode a suivre ?

Feuille 1

Feuille 2

J’espère que c'est assez clair

Merci d'avance pour votre aide.

Bonjour,

Si j'ai bien compris votre besoin, voici un code qui devrait produire l'effet escompté :

Option Base 1

Sub Redisposition()

Dim Pays as range, etat as range
Dim Reorg()
dim i%, n%

With Range("A1").currentregion 'en supposant le tableau de base commençant en A1
    Set Pays = .resize(.rows.count - 1, .columns.count).offset(1,0).columns(1) 'Pays vaut colonne1 du tableau sans l'en-tête
end with

for each etat in Pays pour chaque etat dans Pays
    for i = 1 to Pays.columns.count - 1 'analyse les cellules sur la ligne de l'etat en cours
        if not etat.offset(0, i).value = "" then 'si la case de la colonne i n'est pas vide
            n = n + 1 'incrémentation
            Redim Preserve Reorg(1 to n, 1 to 3) 'tableau Reorg redimensionné
            Reorg(n, 1) = etat.value 'reçoit la valeur de etat
            Reorg(n, 2) = cells(Pays.row - 1, Pays.column + i).value 'reçoit la valeur du titre d'en-tête
            Reorg(n, 3) = etat.offset(0, i).value 'reçoit la valeur de la case i examinée
        end if
    next i 'case suivante sur cette même ligne
next etat 'etat suivant

Sheets(2).Range("A2").resize(Ubound(Reorg, 1), Ubound(Reorg, 2)).value = Reorg 'copie du tableau en A2 de la feuille 2 (redimensionné aux dimensions du tableau)

Msgbox "Reorganisation des donnees terminee !"

end sub

Il faudra peut-être le personnaliser pour l'adapter aux données que vous avez.

Bien cordialement,

Bonjour 3GB,

Merci pour votre aide ! C'est exactement les étapes et process dont j'ai besoin :)

J'ai juste une erreur sur la dernière ligne :

" Erreur d’exécution 9 : L'indice n’apparaît pas dans la sélection"

Sheets(2).Range("A2").resize(Ubound(Reorg, 1), Ubound(Reorg, 2)).value = Reorg 'copie du tableau en A2 de la feuille 2 (redimensionné aux dimensions du tableau)

J'ai adapté " Sheets(2)" Par Sheets("nom de la feuille 2"). C'est bien cela ?

Merci encore pour votre aide précieuse !

Bien cordialement,

Bonjour,

Oui, l'erreur porte sur la feuille qui n'existait probablement pas au moment de l'exécution. Oui, la ligne :

Sheets("nomfeuille2").Range("A2").resize(Ubound(Reorg, 1), Ubound(Reorg, 2)).value = Reorg

c'est très bien aussi (et je dirais même mieux) !

Cordialement,

J'ai la même erreur...

Bien cordialement,

Option Base 1

Sub Redisposition()

Dim Pays as range, etat as range, Destination as range
Dim Reorg()
dim i%, n%

With Range("A1").currentregion 'en supposant le tableau de base commençant en A1
    Set Pays = .resize(.rows.count - 1, .columns.count).offset(1,0).columns(1) 'Pays vaut colonne1 du tableau sans l'en-tête
end with

for each etat in Pays pour chaque etat dans Pays
    for i = 1 to Pays.columns.count - 1 'analyse les cellules sur la ligne de l'etat en cours
        if not etat.offset(0, i).value = "" then 'si la case de la colonne i n'est pas vide
            n = n + 1 'incrémentation
            Redim Preserve Reorg(1 to n, 1 to 3) 'tableau Reorg redimensionné
            Reorg(n, 1) = etat.value 'reçoit la valeur de etat
            Reorg(n, 2) = cells(Pays.row - 1, Pays.column + i).value 'reçoit la valeur du titre d'en-tête
            Reorg(n, 3) = etat.offset(0, i).value 'reçoit la valeur de la case i examinée
        end if
    next i 'case suivante sur cette même ligne
next etat 'etat suivant

Set Destination = Sheets("nomfeuille2").Range("A2").resize(Ubound(Reorg, 1), Ubound(Reorg, 2)) 'on dimensionne le tableau où coller
Destination.value = Reorg 'copie dans ce tableau

Msgbox "Reorganisation des donnees terminee !"

end sub

Essaie ainsi, c'est plus propre.

Quel est le nom de ta feuille 2 ?

J'essaye juste ton code sur un fichier excel de test et mes feuilles s'appellent tout simplement "Feuil1" et "Feuil2".

Et j'ai toujours la même erreur que précédemment.

Merci encore pour ton aide :)

Est-ce que tu peux avec ça :

Option Base 1

Sub Redisposition()

Dim Pays As Range, Annees As Range, etat As Range, Destination As Range
Dim Reorg()
Dim i%, k%, Nbval%

Set Pays = Range("Tableau2")
Set Annees = Pays.Resize(Pays.Rows.Count, Pays.Columns.Count - 1).Offset(0, 1)
Nbval = WorksheetFunction.CountA(Annees)
ReDim Reorg(Nbval, 3)

For Each etat In Pays.Columns(1) 'pour chaque etat dans Pays
    For k = 1 To Annees.Columns.Count 'analyse les etatules sur la ligne de l'etat en cours
        If etat.Offset(0, k).Value <> "" Then 'si la case de la colonne i n'est pas vide
            i = i + 1 'incrémentation
            Reorg(i, 1) = etat.Value 'reçoit la valeur de etat
            Reorg(i, 2) = Cells(1, 1 + k).Value 'reçoit la valeur du titre d'en-tête
            Reorg(i, 3) = etat.Offset(0, k).Value 'reçoit la valeur de la case i examinée
        End If
    Next k 'case suivante sur cette même ligne
Next etat 'etat suivant

Set Destination = Sheets("RECAP").Range("A2").Resize(UBound(Reorg, 1), UBound(Reorg, 2)) 'on dimensionne le tableau où coller
Destination.Value = Reorg 'copie dans ce tableau

MsgBox "Reorganisation des donnees terminee !"

End Sub

J'ai le sentiment d'avoir résolu les problèmes que tu rencontrais. Seulement, je teste sur un mac et je me retrouve avec des erreurs que je n'ai pas sur windows. J'ai galéré et finalement j'ai fait le choix d'enlever le redim preserve dynamique et de faire la redimension du tableau en fonction du nombre de valeurs non vides dans ton tableau feuil1.

Voilà, sinon, la boucle for each etat ne marche pas chez moi mais elle devrait marcher chez toi...

A plus,