Write A Report in Excel using VBA - SQL-server

I wrote first report in Excel-VBA using data from SQL-Server 

Sub runreports()

    

    Dim cnt As ADODB.Connection

    Dim rst As ADODB.Recordset

    Dim stSQL As String

    Dim wbBook As Workbook

    Dim wsSheet As Worksheet

    Dim rnStart As Range

    

     

    Const stADO As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=xxxxx;Data Source=devDB;User ID=myuser;Password=mypass; Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=myPC;Use Encryption for Data=False;Tag with column collation when possible=False"

    

     

    Set wbBook = ActiveWorkbook

    Set wsSheet = wbBook.Worksheets(5)

    

    With wsSheet

        Set rnStart = .Range("A7")

    End With

    'Report Name

    Cells(1, 10).Value = "Interco Report"

    

    stSQL = "SELECT top 100 * FROM tbl_intercoRep"

    'stSQL = "SP_Int_DeleteThis"

'    stSQL = "SP_IntercoReport"

   

     

    Set cnt = New ADODB.Connection

    

    With cnt

        .CursorLocation = adUseClient

        .Open stADO

        .CommandTimeout = 0

        Set rst = .Execute(stSQL)

    End With

   

'Worksheets("sheet5").Activate

Dim ii As Integer

    For ii = 0 To rst.Fields.Count - 1

    Cells(6, ii + 1).Value = rst.Fields(ii).Name

Next ii

 

    With Range("A1:ZZ1").Font

    .Bold = True

    .Size = 15

   

    End With

   

    With Range("A6:ZZ6").Font

    .Bold = True

   

    

    End With

   

     'Here we add the Recordset to the sheet from A1

    rnStart.CopyFromRecordset rst

    

     'Cleaning up.

    rst.Close

    cnt.Close

    Set rst = Nothing

    Set cnt = Nothing

End Sub