Mise en ligne si colonnes remplies

Bonjour,

je dois mettre en ligne des valeurs d'un tableau qui sont dans plusieurs colonnes et recopier certaines informations avant certaines valeurs.

Un exemple est montré dans le fichier Test, l'origine est dans l'onglet 1 et le résultat dans l'onglet 2

Moteur Capa1 Capa2 Capa3 PTY_1 PTY_2 PTY_3

Moteur_1| 4| 4,2| -| NKZ

Moteur_2|4,25[/Tab| 4,5| -| SFY| SFZ

Moteur_3| 3| 3,25| 1| HMP| HMU| HMY

Moteur Capa1 Capa2 Capa3 PTY

Moteur_1| 4| 4,2| -| NKZ

[color=#408000]Moteur_2| 4,25| 4,5| -| SFY

Moteur_2| 4,25| 4,5| -| SFZ

Moteur_3| 3| 3,25| 1| HMP

Moteur_3| 3| 3,25| 1| HMU

Moteur_3| 3| 3,25| 1| HMY

Merci pour vos réponses

7test.xlsx (11.45 Ko)

Bonjour

Si j'ai bien compris, une proposition:

Sub test()
Dim i&, j&, K&, ReportRw&, LstCol&, LstRw&
Dim TData As Variant, TReport As Variant

ReportRw = 1

With Sheets("Source") ' a adapter
    LstRw = .Cells(.Rows.Count, 1).End(3).Row
    LstCol = .Cells(1, .Columns.Count).End(1).Column
    TData = .Range(.Cells(1, 1), .Cells(LstRw, LstCol))
End With

ReDim TReport(1 To (LstRw * LstCol), 1 To 5)
For j = LBound(TReport, 2) To UBound(TReport, 2)
    TReport(1, j) = TData(1, j)
Next j

For i = LBound(TData, 1) + 1 To UBound(TData, 1)
    For j = 5 To UBound(TData, 2)
        If TData(i, j) <> "" Then
            ReportRw = ReportRw + 1
            For K = 1 To UBound(TReport, 2) - 1
                TReport(ReportRw, K) = TData(i, K)
            Next K
            TReport(ReportRw, UBound(TReport, 2)) = TData(i, j)
        End If
    Next j
Next i

With Sheets("Result") ' a adapter
    .Cells.ClearContents
    .Cells(1, 1).Resize(ReportRw, UBound(TReport, 2)) = TReport
End With

End Sub

Cordialement

Merci beaucoup, c'est exactement ce que je recherchais.

Rechercher des sujets similaires à "mise ligne colonnes remplies"