Recopie d'une liste sans les cellules vides

Bonjour

Remplacez le code que je vous ai donné par celui ci-dessous

Sub test()
Dim plage As Range, cel As Range
Dim dlg As Integer, j As Integer
Dim i As Byte
Dim tb As ListObject

Sheets("Feuil2").Range("B2:C500").ClearContents
Set tb = Sheets("Feuil1").ListObjects("Tableau1")
Set plage = tb.ListColumns(2).DataBodyRange
j = 4
For i = 3 To tb.ListColumns.Count
    If WorksheetFunction.CountA(plage.Offset(, i - 2)) >= 1 Then
        For Each cel In plage
            With Sheets("Feuil2")
                If cel.Value = .Range("A2").Value Then
                    dlg = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Range("B" & dlg) = cel.Offset(0, i - 2).Value
                    If cel.Offset(0, i - 2).Value <> vbNullString Then .Range("C" & dlg) = cel.Offset(0, i - j).Value
                End If
            End With
        Next cel
    End If
    j = j + 1
Next i
End Sub

Bonjour

C'est parfait merci pour cette aide précieuse

Cordialement