Bonjour à tous,
Une piste à étudier.
Cdlt.
Public Sub DEMO()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim plano As String
Dim Tpm()
Dim n As Long, i As Long, j As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("MENU")
plano = ws.Cells(2, 22).Value
On Error Resume Next
Set ws2 = wb.Worksheets(plano)
On Error GoTo 0
If ws2 Is Nothing Then
MsgBox "La feuille " & plano & " n'existe pas !...", 64, "Information"
Else
With ws2
n = .Cells(.Rows.Count, 10).End(xlUp).Row
For i = 6 To n
If Not IsEmpty(.Cells(i, 13)) Then
ReDim Preserve Tpm(3, j + 1)
Tpm(0, j) = .Cells(i, 10).Value
Tpm(1, j) = .Cells(i, 12).Value
Tpm(2, j) = .Cells(i, 13).Value
j = j + 1
End If
Next i
'If j > 0 Then .Cells(1).Resize(j, 3).Value = Application.Transpose(Tpm)
End With
End If
End Sub