Esta macro inicia desde una fila y cuenta las filas con datos hasta que encuentra una celda vacía, luego copia esas celdas y las pega transpuestas en la columna de a la par.
Ejemplo:
Supongamos los siguientes datos:
Carlos Fuentes
La fiesta del chivo
ISBN
Website
Gabriel García Márquez
Cien años de soledad
ISBN
Website
Email
Mario Vargas Llosa
Los jefes
ISBN
Website
Email
Teléfono
Como podemos observar cada registro tiene un número variable que determina el rango a seleccionar y copiar (4, 5 y 6 respectivamente).
Sub SaveSolutions()
Dim band As Boolean
Dim count As Long
Dim cont As Integer
Dim a, b As Integer
band = True
a = 2 'controla renglones (indica que inicia en la fila 1)
b = 2 'controla renglones (indica que inicia en la fila 1)
count = 0 'inicia el contador en cero
Do
'Nombre de la hoja donde van los datos
Sheets("Hoja1").Select
Do
Cells(a, "A").Select
' Inicia el loop hasta que encuentre una celda vacía en la fila de la columna
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(0, 1))
' Se detiene hasta que encuentre dos filas vacías consecutivas
ActiveCell.Offset(1, 0).Select
count = count + 1
Loop
If Cells(a, "A") <> "" Then
Range(Cells(a, "A"), Cells(a + count, "A")).Select
Application.CutCopyMode = False
Selection.Copy
'Nombre de la hoja en donde se pegarán los datos
Sheets("Hoja1").Select
'La varible b controla las filas en donde se pegarán los valores transpuestos
Cells(b, "B").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
a = a + count + 1
b = b + 1
cont = 0
count = 0
Else
a = a + count
cont = cont + 1
End If
'este if controla los espacios vacíos si hay más de 2 filas continuas sin datos
'indica que ya no hay más datos para copiar en la columna y termina el proceso
If cont >= 2 Then
band = False
End If
Loop While band = True
Loop Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(0, 2))
End Sub