[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, k&
Dim oDat, oRcp, oFeuil, nRcp&, nCol&
nCol = 2
ReDim oRcp(1 To nCol, 1 To 1)
oFeuil = Array("onglet récap", "1er onglet", "2ème onglet")
For k = 1 To UBound(oFeuil)
With Worksheets(oFeuil(k))
oDat = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, nCol - 1)).Value
End With
For i = 3 To UBound(oDat, 1)
If Not IsEmpty(oDat(i, 2)) Then
nRcp = nRcp + 1
ReDim Preserve oRcp(1 To nCol, 1 To nRcp)
For j = 1 To nCol
oRcp(j, nRcp) = oDat(i, j)
Next j
End If
Next i
Next k
With Worksheets(oFeuil(0))
.Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, nCol - 1)).Offset(1, 0).ClearContents
.Cells(7, 1).Resize(UBound(oRcp, 2), nCol).Value = WorksheetFunction.Transpose(oRcp)
End With
End Sub[/B][/COLOR]