.CopyfromRecordset row by row

[justvba]

Hi I want to paste 1 row at a time from a record set so that I can make it paste on a single row or some how transpose the record set results.

sub hi()

Dim cnnConnect As ADODB.Connection
Dim rstRecordset As ADODB.Recordset

Set cnnConnect = New ADODB.Connection

cnnConnect.Open "Provider=OraOLEDB.Oracle;" & _
"Data Source=query;" & _
"User ID=boo;Password=hey;"

Range("B1").Select

Do Until IsEmpty(Range("A" & ActiveCell.Row)) Or Trim(Range("A" & ActiveCell.Row)) = ""
someproduct = UCase(Trim(Range("A" & ActiveCell.Row)))

SQLSTATEMENT = "SELECT A.house, A.Signal, b.Car FROM " & _
"table.one A LEFT JOIN table.two b ON A.house = b.house " & _
"WHERE TRIM(A.make) IN ('" & someproduct & "')"

Set rstRecordset = New ADODB.Recordset
rstRecordset.Open _
Source:=" " & SQLSTATEMENT & " ", _
ActiveConnection:=cnnConnect, _
CursorType:=adOpenForwardOnly

ActiveCell.CopyFromRecordset rstRecordset
ActiveCell.Offset(1, 0).Select
Loop
Set cnnConnect = Nothing
Set rstRecordset = Nothing

END SUB