Problema al importar datos de MySql a Excel

Tengo un libro donde mediante una macro importo los datos de una base de datos MySql a una hoja de Excel, el problema que tengo es que una instrucción, toma la base de MySql, y va registro por registro copiando la información en la hoja de Excel, y la base completa tiene más de 140.000 registros, por lo que el proceso es bastante demorado; quisiera saber si puedo cambiar la instruccion para que tome en bloque los datos que hay en MySql y los pegue en Excel, es decir no registro por registro, sino en bloque; la instrucción es la siguiente:

Sub ConectarConBaseDatos()
'en referencias acitvar
'microsoft activex data objects 2.5 library - en office 2010
'microsoft activex data objects 6.1 library - en office 2019
'instalar mysql-connector-odbc-8.0.16-win32
Sheets("HOJADATOS").Select
Range("A1").Select

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim nCampos&, x As Integer
Dim nRegistros&, y As Long
Dim sql$, BD$, Servidor$, User$, Clave$

Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
Let sql = "Select * From ventas"
Let Servidor = "localhost": Let BD = "Mi_Base_db"
Let User = "root": Let Clave = "admin"

cnn.ConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};" _
& "SERVER=" & Servidor & ";DATABASE=" & BD & ";" _
& "UID=" & User & ";PWD=" & Clave & ";PORT=3306;OPTION="
cnn.Open

With rst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open sql, cnn, , , adCmdText
End With

Let nCampos = rst.Fields.Count
Let nRegistros = rst.RecordCount

For x = 1 To nCampos
Cells(1, x) = rst.Fields(x - 1).Name
Next x

For y = 1 To nRegistros '=====esta instrucción es la demorada, va fila por fila, copiando registro por registro en la hoja de Excel
For x = 1 To nCampos
Cells(y + 1, x).Value = rst.Fields(x - 1).Value
Next x
rst.MoveNext
Next y

cnn.Close
Set rst = Nothing: Set cnn = Nothing

End Sub

¿Alguien puede ayudarme con la instrucción?