Intenta con esto:
Código:
Sub doit()
Sheets("Captura").Select
Range("B3:B16").Select
Selection.Copy
Sheets("Base de datos").Select
Dim var As String
Dim CUENTA As Integer
var = ActiveSheet.Cells(1000, 3).Value
CUENTA = 1
Do While var <> ""
var = ActiveSheet.Cells(1000 + CUENTA, 3).Value
CUENTA = CUENTA + 1
Loop
ActiveSheet.Cells(1000 + CUENTA, 3).Activate
row1 = ActiveCell.Row
col2 = ActiveCell.Column
ActiveSheet.Cells(row1 - 1, col2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
Sí quieres saber que hace cada línea te recomiendo que en tu barra vertical lateral izquierda (a ladito del código) le des click hasta que salga un puntito rojo, y cuando corras la macro te va a "remarcar" on amarillo la línea que se va ejecutando con el código, para ir avanzando al siguiente paso solo oprime F8 y podrás ver con detalle lo que se realiza en pantalla