Macro création liste depuis tableau

Bonsoir la communauté,

je cherche une macro qui me permettrait de créer une liste en fonction d'un tableau.

L'exemple est en pièce jointe sur un tableau réduit.

Actuellement j'utilise une macro de manière très empirique en copier/coller pour chaque colonne. Par contre il est compliqué de la faire évoluer lorsque le tableau comprend entre 800 et 1000 lignes et une bonne trentaine de colonnes.

Merci pour votre aide.

Bonne soirée !

Bonjour,

Une proposition à étudier.

A te relire.

Cdlt.

Bonjour Jean Eric,

C'est magnifique ! quelques lignes pour remplacer une macro de 3 pages !!!

Par contre, j'ai besoin de rajouter une variable aux 2 premières colonnes. J'ai un peu essayé de bidouiller le code ce Week end sans arriver a quelque chose de probant. Est ce que tu aurais la possibilité et surtout l'amabilité de le modifier ?

Merci par avance !

Cordialement

Frédéric

Bonjour,

Ton fichier en retour.

La boucle sur les colonnes doit maintenant commencer à 4 (J).

Cdlt.

Public Sub Create_table()
Dim tbl As Variant, arr() As Variant
Dim I As Long, J As Long, k As Long
    With Worksheets("Feuil1")
        tbl = .Cells(1).CurrentRegion.Value
        For I = 2 To UBound(tbl)
            For J = 4 To UBound(tbl, 2)
                If tbl(I, J) <> "" Then
                    ReDim Preserve arr(4, k + 1)
                    arr(0, k) = tbl(I, 1)
                    arr(1, k) = tbl(I, 2)
                    arr(2, k) = CLng(tbl(I, J))
                    arr(3, k) = tbl(1, J)
                    k = k + 1
                End If
            Next J
        Next I
    End With
    With Worksheets("Feuil2")
        With .ListObjects(1)
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            .InsertRowRange.Cells(1).Resize(k, 4).Value = Application.Transpose(arr)
        End With
        .Activate
    End With
End Sub

Re,

bon, j'ai cherché à faire apparaître la colonne supplémentaire dans le résultat en rajoutant la variable H, j'y suis presque sauf que les 2 premières lignes sont erronées.

voici le code modifié erroné :

Public Sub Create_table()

Dim tbl As Variant, arr() As Variant

Dim H As Long, I As Long, J As Long, k As Long

With Worksheets("Feuil1")

tbl = .Cells(1).CurrentRegion.Value

For H = 2 To UBound(tbl)

For J = 4 To UBound(tbl, 2)

If tbl(H, J) <> "" Then

ReDim Preserve arr(5, k + 1)

arr(0, k) = tbl(H, 1)

arr(1, k) = tbl(H, 2)

arr(2, k) = tbl(H, 3)

arr(3, k) = CLng(tbl(H, J))

arr(4, k) = tbl(1, H)

k = k + 1

End If

Next J

Next H

End With

With Worksheets("Feuil2")

With .ListObjects(1)

If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete

.InsertRowRange.Cells(1).Resize(k, 5).Value = Application.Transpose(arr)

End With

.Activate

End With

End Sub

Bonjour,

Il va falloir apprendre à reproduire !...

Remplace :

arr(4, k) = tbl(1, H)

Par :

arr(4, k) = tbl(1, J)

Cdlt.

Magnifique !!

et oui c'est un métier …. et moi je rame tant que je peux

Enfin, heureusement qu'il y a des spécialistes comme sur ce forum pour filer un coup de main et nous sortir du brouillard !

Merci encore

Bonne continuation

Bonjour Jean Eric,

une dernière petite question, si je mets des dates en colonne 2, lorsqu'elles remontent dans le tableau après la macro, elles n'ont plus le même format (JJ/MM/AAAA).

j'ai essayé le "dim as Date" mais cela ne change rien..

Si tu peux jeter un oeil ?

merciiiii

Bonjour,

Ton fichier en retour, modifié en conséquence.

arr(1, k) = CLng(tbl(I, 2))

Cdlt.

top !

merci beaucoup Jean Eric