INSERTION DONNÉES VBA -- ADO

Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim strMetier As String '--> Recherche d'un métier
Dim strPoste As String '--> Le poste
'Création de la connection à la base locale courante
Set cnn = CurrentProject.Connection
strMetier = InputBox("Saisir le métier ?", "NetJoao")
Debug.Print "Métier : " & strMetier
'Récupération des postes en fonction du métiers
rst.Open "SELECT POSTE FROM PANDORE_POSTE WHERE METIER=UCASE('" & strMetier & "')", cnn, adOpenKeyset
'Création de command
With cmd
    .ActiveConnection = cnn
    'Boucle sur les postes
    Do Until rst.EOF
        .CommandText = "INSERT INTO PANDORE_POSTCOMP([POSTE],[COMPET],[ORIGINE],[ACTION],[REMNIV],[NOTE]) " & _
                        "SELECT '" & rst.Fields(0) & "',[COMPET],'M','C',[REMNIV], [NOTE] " & _
                        "FROM PANDORE_METCOMP " & _
                        "WHERE METIER=UCASE('" & strMetier & "')"
        .CommandType = adCmdText
        .Execute
        Debug.Print "Poste : " & strPoste
        rst.MoveNext
    Loop
End With
rst.Close
Set cmd = Nothing
Set cnn = Nothing
End Sub