Macro que copia datos de forma horizontal a vertical Review:

Podría ser algo así:

Sub xxx()
Dim coleccion As New Collection
Dim MatrizFinal() As String
Set Rng = Range("A1:D2")    'donde esté el rango con datos
x = 0
For Each celda In Rng
   x = x + 1
   coleccion.Add celda.Value
Next celda
ReDim MatrizFinal(1 To x) As String
For m = 1 To coleccion.Count
    MatrizFinal(m) = coleccion(m)
Next m
Range("G1:G" & x).Value = Application.Transpose(MatrizFinal)
End Sub

Espero te ayude.

H o l a:

Te anexo la macro

Sub CopiarDatos()
'Por.Dante Amor
    j = 1
    For Each c In Sheets("Hoja1").Range("A1").CurrentRegion
        Sheets("Hoja2").Cells(j, "A") = c.Value
        j = j + 1
    Next
    MsgBox "Fin"
End Sub

':)
':)