Conversion tableau vers liste

[Windfly]

Bonjour le forum,

J'ai besoin de votre aide afin de faire la chose suivante :
Dans le fichier excel ci-joint, je voudrais faire une macro qui permette de passer d'un tableau (non croisé dynamique) (voir 1er feuille) à une forme de liste (du type 2eme feuille).

Contrainte : je ne dois transformer de façon linéaire uniquement des valeurs jaunes et pas les autres.

Merci beaucoup pour votre aide.

Windfly

 

[kjin]

Re : Conversion tableau vers liste

Bonjour,
Fichier xlsx !
A+
kjin

 

[Windfly]

Re : Conversion tableau vers liste

Oups... Désolé (je n'ai pas encore l'habitude de excel 2007)
Voici le bon fichier.

Slt

Windfly

 

[CBernardT]

Re : Conversion tableau vers liste

Bonjour Windfly, kjin et le forum,

Essayes avec cette macro de transfert.

Option Explicit
Sub transfert()
Dim Derlig As Integer, Plage As Range, Cel As Range

With Sheets("Tableau")
Derlig = .Range("A65536").End(xlUp).Row
Set Plage = .Range("A3:F" & Derlig)
End With
With Sheets("Liste")
For Each Cel In Plage
If Cel.Interior.ColorIndex = 6 Then
Derlig = .Range("A65536").End(xlUp).Row
.Range("A" & Derlig + 1) = Cel.EntireRow.Range("A1")
.Range("B" & Derlig + 1) = Cel.EntireRow.Range("B1")
.Range("C" & Derlig + 1) = Cel.EntireRow.Range("C1")
.Range("D" & Derlig + 1) = Cel.EntireColumn.Range("A2")
.Range("E" & Derlig + 1) = Cel.Value
End If
Next Cel
End With
End Sub

 

[Windfly]

Re : Conversion tableau vers liste

Super, grand merci Bernard!

Comme d'habitude, le forum est très efficace et très réactif.

Merci encore et à bientot

Windfly

 

[kjin]

Re : Conversion tableau vers liste

Bonjour,
Il me semble qu'il y a une erreur dans ton exemple !

Option Base 1

Sub transfert()
Dim T() As Variant, i As Long, j As Long, x As Long
With Sheets("Tableau")
    nbL = .Range("A65000").End(xlUp).Row
    nbC = .Range("A2").End(xlToRight).Column
    For i = 3 To nbL
        For j = 4 To nbC
            If .Cells(i, j).Interior.ColorIndex <> xlNone Then
                x = x + 1
                ReDim Preserve T(5, 1 To x)
                T(1, x) = .Cells(i, 1)
                T(2, x) = .Cells(i, 2)
                T(3, x) = .Cells(i, 3)
                T(4, x) = .Cells(2, j)
                T(5, x) = .Cells(i, j)
            End If
        Next
    Next
End With
With Sheets("Liste")
    .Range(.Cells(2, 1), .Cells(UBound(T, 2) + 1, 5)) = Application.Transpose(T)
End With

End Sub

Edit : bonjour Bernard 🙂
A+
kjin