Optimiser le temps de chargement des données

Bonjour,
j'ai créé un macro Excel VBA lié avec une BDD ACCESS. le problème que les tables de la BDD

contient beaucoup de données. Du coup pour chercher des données ça prend beaucoup du temps.

il a-t-il une piste pour optimiser la boucle do while.

Voilà mon code:
<
Set BDD = OpenDatabase(PATH_BDD)
Set TB = BDD.OpenRecordset("Select * From POL where [PROJET] = '" & UserForm1.ComboBox1 & "' and [SOUS_TRAITANT] = '" & UserForm1.ComboBox2 & "' and [NOM_DU_LOT] = '" & UserForm1.ComboBox3 & "' and [PHASE] = '" & UserForm1.ComboBox9 & "' and [TRONCON] = '" & UserForm1.ComboBox5 & "' and [SECTION] = '" & UserForm1.ComboBox6 & "';")
'ouvrir l'onglet POL
With Workbooks.Application
.Worksheets("POL").Activate

'Copies/coller des données POL de BDD dans CAPEX
DL = 2
Do While TB.EOF = False
.Cells(DL, 1).Value = TB.Fields("INF_NIVEAU")
.Cells(DL, 2).Value = TB.Fields("INF_SUPP")
.Cells(DL, 3).Value = TB.Fields("INF_ID_NOEUD")
.Cells(DL, 4).Value = TB.Fields("INF_TYPE_DEPL")
.Cells(DL, 5).Value = TB.Fields("NOM_DU_LOT")
.Cells(DL, 6).Value = TB.Fields("ANNEE")
.Cells(DL, 7).Value = TB.Fields("INF_LONGUEUR")
DL = DL + 1
TB.MoveNext
Loop

'Copies/coller des données CB dans CAPEX
Set TB = BDD.OpenRecordset("Select * From CB where [PROJET] = '" & UserForm1.ComboBox1 & "' and [SOUS_TRAITANT] = '" & UserForm1.ComboBox2 & "' and [NOM_DU_LOT] = '" & UserForm1.ComboBox3 & "' and [PHASE] = '" & UserForm1.ComboBox9 & "'and [TRONCON] = '" & UserForm1.ComboBox5 & "' and [SECTION] = '" & UserForm1.ComboBox6 & "';")
.Worksheets("CB").Activate
DL = 2
Do While TB.EOF = False
.Cells(DL, 1).Value = TB.Fields("CB_NIVEAU")
.Cells(DL, 2).Value = TB.Fields("CB_MODE_POSE")
.Cells(DL, 3).Value = TB.Fields("CB_FIBRES")
.Cells(DL, 4).Value = TB.Fields("CB_ID_NOEUD")
.Cells(DL, 5).Value = TB.Fields("CB_TYPE_DEPL")
.Cells(DL, 6).Value = TB.Fields("NOM_DU_LOT")
.Cells(DL, 7).Value = TB.Fields("ANNEE")
.Cells(DL, 8).Value = TB.Fields("CB_LONGUEUR")
.Cells(DL, 9).Value = TB.Fields("CB_LONGUEUR") * TB.Fields("CB_FIBRES")
DL = DL + 1
TB.MoveNext
Loop
...>
Merci d'avance,