Sub copie()
Dim tablo()
'copie l'ensemble des cellules si l'une est non vide
tablo = Range(Cells(2, 2), Cells(5, 4)) ' range("B2:D5"))
For n = 1 To UBound(tablo, 1)
For m = 1 To UBound(tablo, 2)
x = x & tablo(n, m)
Next m
Next n
If x <> "" Then
Range(Cells(2, 2), Cells(5, 4)).Copy Destination:=Cells(10, 2) ' (Range("B10")
End If
End Sub