VBA having column name and value down the left of the worksheet

[nutbolt]

Rather than have all my column names across the top of the worksheet, I'm looking to have them down the left hand side eg in Column A. The value of that will then be in Column B. I have used a recordset which loops through and pulls the first column correctly, but I need 30 more columns to do the same with the values. Where am I going wrong?

' Run the query and store the retrieved data in the recordset
Set adoRecordset = adoCommand.Execute
' Set to the first empty row
intRow = 10
' Loop through the recordset
Do While Not adoRecordset.EOF
    For rs = 0 To adoRecordset.Fields.Count - 1
    
        With shtData
                     
                With .Cells(intRow, intCol + 1)
               
                ' Write the data to the cells
                .Cells(intRow, intCol + 1).Value = adoRecordset.Fields(intCol).Name
                .Cells(intRow, intCol + 2).Value = adoRecordset.Fields(intCol).Value
          
                End With
           
        End With
    ' Go to the next column in the record
    Next rs
    'Next intRow
    
    ' Go to the next row
    intRow = intRow + 1
    ' Move to the next record in the recordset
    adoRecordset.MoveNext
Loop
' Reset the recordset
Set adoRecordset = Nothing
' Reset the command
Set adoCommand = Nothing
' Closet and reset the connection
adoConnection.Close
Set adoConnection = Nothing

 

[Legacy 143009]

I suppose you are looking for transposing.

Sub Transpose_Example2()
  Dim lRow As Long

  ActiveSheet.UsedRange.Cut 'Or your data range like Range("A1:C5")
  Range("A1").PasteSpecial Transpose:=True
 'Delete after this part if you don't want reverse order
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lRow
        Cells(i, 1).EntireRow.Cut
        Cells(1, 1).EntireRow.Insert Shift:=xlDown
  Next i
End Sub