insert FIRST ROW of RS

[Johnny42]

I'm using this code to list all TABLES froma DB along with there column headings...
I would like to also add the 1st row of data...

Sub ListTablesADO() '[URL unfurl="true"]http://www.motobit.com/tips/detpg_listdb/[/URL]

  Dim TablesSchema As ADODB.Recordset
  Dim ColumnsSchema As ADODB.Recordset
Dim strConnect1 As String
Set cnn1 = New ADODB.Connection
strConnect1 = "Provider=SQLOLEDB.1;Password=1xxx;Persist Security Info=True;User ID=john;Initial Catalog=ColexionPerezData;Data Source=xxxxxx"
cnn1.Open strConnect1
  
  'Get all database tables.
  Set TablesSchema = cnn1.OpenSchema(adSchemaTables)
  
  r = 1
  c = 1
  
  Do While Not TablesSchema.EOF
  If TablesSchema("TABLE_TYPE") = "TABLE" Then
    'Get all table columns.
    Set ColumnsSchema = cnn1.OpenSchema(adSchemaColumns, _
      Array(Empty, Empty, "" & TablesSchema("TABLE_NAME")))
    Cells(r, c) = TablesSchema("TABLE_NAME")
    r = r + 1
    Do While Not ColumnsSchema.EOF

        Cells(r, c) = ColumnsSchema("COLUMN_NAME")
        
       ColumnsSchema.MoveNext
      r = r + 1
   Loop
    r = 1
    c = c + 1
    End If
    TablesSchema.MoveNext
  Loop
      cnn1.Close
End Sub