run time error '3265': item cannot be found in the collection corresponding to the reques

here i am trying displaying actual columnname(header) please help me out

1st columname is wds_id but second colmn name displaying as Fields(actual column name is Company Name)..etc

   Dim cnt As ADODB.Connection
    Dim rst1 As ADODB.Recordset, rst2 As ADODB.Recordset
    Dim stDB As String, stSQL1 As String, stSQL2 As String
    Dim strConn As String
    Dim wbBook As Workbook
    Dim Sheet1 As Worksheet
    Dim i
    Dim lnField As Long, lnCount As Long
    Dim dataStr As String
     'Instantiate the ADO-objects.
    Set cnt = New ADODB.Connection
    Set rst1 = New ADODB.Recordset
    Set rst2 = New ADODB.Recordset

    Set wbBook = ThisWorkbook
    Set Sheet1 = wbBook.Worksheets(1)

     'Path to the database.
    stDB = "mysql32"

     'Create the connectionstring.
    strConn = "Driver=MySQL ODBC 5.2 Unicode Driver;" _
    & "Data Source=" & stDB & ";"

     'The 1st raw SQL-statement to be executed.
     ' stSQL1 = "SELECT * FROM tblbatch_headers where idBatch " & batchID & "order by col_seq asc"

     'The 2nd raw SQL-statement to be executed.
     stSQL2 = "SELECT * FROM  " & InputBox("Enter the Batch Name") & "  where FQR_User_Code='" & Application.username & _
         "' and line_status in('QP') order by line_status" '
     'Clear the worksheet.
     Sheet1.Range("A1:FA1").CurrentRegion.Clear



    With cnt
        .Open (strConn)   'Open the connection.
        .CursorLocation = adUseClient 'Necessary to disconnect the recordset.
    End With

     With rst1
'       .Open stSQL1, cnt    'Create the recordset.
       Set .ActiveConnection = Nothing 'Disconnect the recordset.
     End With

    With rst2
        .Open stSQL2, cnt 'Create the recordset.
        Set .ActiveConnection = Nothing 'Disconnect the recordset.
    End With

    With Sheet1
'        .Cells(2, 1).CopyFromRecordset rst1 'Copy the 1st recordset.
     For i = 1 To rst2.Fields.count
            .Cells(2, i).Value = rst2.Fields(i - 1).Name
         Next i
        .Cells(3, 1).CopyFromRecordset rst2 'Copy the 2nd recordset.
   End With
   
   rst2.MoveFirst
      i = 0
   Do While rst2.EOF = False
       Dim rng As Range
          i = i + 1
            ActiveSheet.Cells(1, i) = rst2("Comments")
            ActiveSheet.Cells(2, i) = rst2("ActualColName")
            ActiveSheet.Cells(2, i).ID = rst2("tblColName")
               rst2.MoveNext
           Loop
                ActiveSheet.Cells(2, i + 1).ID = prdTblName
         rst2.Close
      '  dbconn.Close

     'Release objects from the memory.
'    rst1.Close
   '  Set rst1 = Nothing
    rst2.Close
    Set rst2 = Nothing
    cnt.Close
    Set cnt = Nothing