Sub aa()
Dim cnPubs As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnPubs = New ADODB.Connection
Set rst = New ADODB.Recordset
Dim strConn As String
Dim sqltbz As String

strConn = "PROVIDER=SQLOLEDB.1;"
strConn = strConn & "DATA SOURCE=local;INITIAL CATALOG=bd_ex;"
strConn = strConn & " INTEGRATED SECURITY=sspi;"
cnPubs.Open strConn

rst.ActiveConnection = cnPubs
rst.Open "SELECT * FROM NewPki501"
Lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Lastrow = Lastrow + 1
Лист1.Range("A" & Lastrow).CopyFromRecordset rst

cnPubs.Close
Set rst = Nothing
Set cnPubs = Nothing
End Sub

iRowsCount = rst.RecordCount
If iRowsCount > 0 Then
    iFieldsCount = rst.Fields.Count
        For i = 1 To iFieldsCount
            Cells(Lastrow, i).Value = rst.Fields(i - 1).Name
        Next

    i = Lastrow + 1
    Do Until rst.EOF
        For j = 1 To iFieldsCount
            Cells(i, j) = rst(j - 1)
        Next j
    rst.MoveNext
    i = i + 1
    Loop
End If

For сol = 0 To rst.Fields.Count - 1
           Cells(Lastrow, 1 + сol).Value = rst.Fields(сol).Name
Next

Лист1.Range("A" & (Lastrow+1)).CopyFromRecordset rst