Sub LoopThroughRecordset(rst As ADODB.Recordset, rg As Range)
Dim nColumnOffset As Integer
Dim fld As ADODB.Field
With rst
Do Until .EOF
nColumnOffset = 0
For Each fld In .Fields
rg.Offset(0, nColumnOffset).Value = fld.Value
nColumnOffset = nColumnOffset + 1
Next
Set rg = rg.Offset(1, 0)
.MoveNext
Loop
End With
Set fld = Nothing
End Sub