Sub PNT_R()
Application.ScreenUpdating = False
DA = Range("F12").Value
Sheets("TX_Global_Zone").Select

LIGNE_DA = Cells.Find(what:=DA, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Row

Dim Connexion As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim CheminBase As String
Dim CompteChamps As Long
Dim Requete As String
Dim NomTable As String
   
'Taux Global
CheminBase = "N:\Calexpress\13 - METHODES\13.2 Public\13.2.3 Divers\97 - Bases de données\POINTAGE\Taux_pointage.mdb"
Connexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & CheminBase & ";"

Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
    
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

Range("B" & LIGNE_DA) = Rs.Fields("Somme_Colis")
Range("C" & LIGNE_DA) = Rs.Fields("Somme_Colis_non_lus")
Range("D" & LIGNE_DA) = Rs.Fields("Taux")

Set Rs = Nothing

'Taux Mode
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.Mode"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
    
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
    
Do Until Rs.Fields("Mode").Value = "D"
Rs.MoveNext
Loop
Range("E" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Mode").Value = "R"
Rs.MoveNext
Loop
Range("F" & LIGNE_DA) = Rs.Fields("Taux")
Set Rs = Nothing

'Taux Zone
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & ") AND ((Equipe.Equipe) Is Null));"

    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

Do Until Rs.Fields("Zone").Value = "Z1"
Rs.MoveNext
Loop
Range("G" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z2"
Rs.MoveNext
Loop
Range("H" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z3"
Rs.MoveNext
Loop
Range("I" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z4"
Rs.MoveNext
Loop
Range("J" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z5"
Rs.MoveNext
Loop
Range("K" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z6"
Rs.MoveNext
Loop
Range("L" & LIGNE_DA) = Rs.Fields("Taux")

Set Rs = Nothing

'Taux Equipe Nuit
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Equipe.Equipe"
Requete = Requete & " FROM (Expedition LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur) LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225) AND ((Equipe.Equipe)='N'));"
    
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

Range("M" & LIGNE_DA) = Rs.Fields("Taux")

Set Rs = Nothing

'Taux CD
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.CD"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.CD"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225));"


    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

Sheets("REQUETE").Range("A1").CopyFromRecordset Rs

Sheets("REQUETE").Select
lg = Range("A1").End(xlDown).Row
For i = 1 To lg
    CD = Range("B" & i).Value
    TX = Range("C" & i).Value
    Sheets("TX_CD").Select
        Set PlageDeRecherche = ActiveSheet.Rows(1)
        Set Trouve = PlageDeRecherche.Cells.Find(what:=CD, LookAt:=xlWhole)
        If Trouve Is Nothing Then
            GoTo suite
        Else
            COLONNE = Trouve.Column
            Set MaPlage = Columns(COLONNE).Rows(LIGNE_DA)
            MaPlage.Value = TX
            If MaPlage.Value = "" Then
                MaPlage.Value = 100
            End If
        End If
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

suite:
    Sheets("REQUETE").Select

Set Connexion = Nothing

End Sub