Sub copier()
toto Sheets("Feuil1").Range("B70,C70,B47,C71,B31,B48,B49,B33,B44,B46,B42,B43,B35:B41"), _
Sheets("Feuil2").Range("B4") 'Données et destination à adapter.
End Sub
Sub toto(Orig As Range, Dest As Range, Optional sens$ = "")
'
'Syntaxe :
'toto plage_à_copier, première_cellule_de_destination[, sens]
'sens="" ou omis : recopie verticale
'sens<>"" : recopie horizontale
'
Dim i&, a&, oPlg As Range, oCel As Range, sDat()
With Orig
ReDim sDat(1 To .Cells.Count)
For Each oPlg In .Areas
For a = 1 To oPlg.Count: i = i + 1: sDat(i) = oPlg(a): Next
Next oPlg
If sens = "" Then
Dest.Resize(.Cells.Count, 1).Value = WorksheetFunction.Transpose(sDat)
Else
Dest.Resize(1, .Cells.Count).Value = sDat
End If
End With
End Sub