Bonjour,
Une proposition à étudier.
Cdlt.
Public Sub DEMO()
Dim r As Long, c As Long
Dim lastRow As Long, lRow As Long
Application.ScreenUpdating = False
Feuil2.Cells(2, 2).CurrentRegion.Offset(1, 0).Clear
lRow = 3
With Feuil2
If Not .ListObjects(1).DataBodyRange Is Nothing Then _
.ListObjects(1).DataBodyRange.Delete
End With
With Feuil1
lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
For r = 3 To lastRow
For c = 3 To 15
If IsEmpty(.Cells(r, c)) Then
Feuil2.Cells(lRow, 2) = .Cells(r, 2)
Feuil2.Cells(lRow, 3) = .Cells(r, 3)
Feuil2.Cells(lRow, 4) = .Cells(2, c)
lRow = lRow + 1
End If
Next c
Next r
End With
End Sub