Macro RechercheV

Bonjour,

une fois de plus je reviens vers vous parce que j'ai essayé plusieurs technique et le code ne fonctionne pas.

voici ce que je fais :

à partir d'un autre fichier je copie et viens coller les données de mes 4 premières colonnes de la feuille Base (opération mannuelle)

je souhaite via une macro :

- si le salarié n'est pas dans la liste => il copie le nom, le service, l'établissement et les heures dans le bon mois (en fonction du mois indiqué en cellule B6) (pas de souci le code que j'ai indiqué fonctionne)

voici le code actuel et le fichier

Sub MAJListe()

'Call ProtVBA

'mise àjour des valeur conditionnelle si non présent dans la liste finale
 Dim i&, ln&
 Dim Fc, Fo As Worksheet
 Dim lnC, lnO, ClnM, v
Set Fc = WsRlv 'feuille_cible
Set Fo = WsB 'feuille_origine
 lnC = 6 'n°_première_ligne_cible
 lnO = 9 'n°_première_ligne_origine
Set ClnM = Fo.Range("E6") ' colonne du mois

 For i = lnO To Fo.Range("A8").End(xlDown).Row
            DL = Fc.Range("A" & Rows.Count).End(xlUp).Row
            If Application.WorksheetFunction.CountIf(Fc.Range("A6:A" & DL), Fo.Range("A" & i)) = 0 Then
                ln = lnC
                Do While Fc.Range("A" & ln) <> ""
                    ln = ln + 1
                Loop
                Fc.Range("A" & ln) = Fo.Range("A" & i)
                Fc.Range("N" & ln) = Fo.Range("B" & i)
                Fc.Range("O" & ln) = Fo.Range("C" & i)
                Fc.Range(ClnM & ln) = Fo.Range("D" & i)
            End If
Next i

'Suppression des lignes vides
Dim NbreLigneMax As Long
    NbreLigneMax = Cells(Rows.Count, 1).End(xlUp).Row
    For i = NbreLigneMax To 7 Step -1
        If Fc.Range("A" & i).Value = "" Then
            Rows(i).EntireRow.Delete
        End If
   Next

End Sub

- si le salarié est déjà dans la liste, je voudrais qu'il vienne me copier uniquement les heures dans la bonne colonne (colonne du mois concerné)

(copier les données d'une éventuelle recherche v (salarié feuille relevé, tableau feuille base, colonne 4, faux))

et c'est là que j'ai besoin de votre aide, parce que j'ai essayé plusieurs code et rien ne fonctionne.

pour faire le test, je vous ai mis sur la feuille base les données du mois de mars que je souhaite copier (ces données vont remplacer les données du mois de mars déjà existantes)

Bonjour,

Essayez ceci (Pas testé car votre fichier est protégé)

    If Application.WorksheetFunction.CountIf(fc.Range("A6:A" & Dl), Fo.Range("A" & i)) = 0 Then
        Ln = lnC
        Do While fc.Range("A" & Ln) <> ""
            Ln = Ln + 1
        Loop
        fc.Range("A" & Ln) = Fo.Range("A" & i)
        fc.Range("N" & Ln) = Fo.Range("B" & i)
        fc.Range("O" & Ln) = Fo.Range("C" & i)
        fc.Range(ClnM & Ln) = Fo.Range("D" & i)
    Else
        With fc.Range("A6:A" & Dl)
            Set x = .Find(Fo.Range("A" & i), lookat:=xlWhole)
            fc.Range(x.Row, ClnM) = Fo.Range("D" & i)
        End With
    End If

Cdlt

Bonjour,

Désolé j'avais oublier de déverrouiller le VBA. je vous joint le fichier déverrouillé.

j'ai testé votre code mais il ne fonctionne pas, il y a une erreur sur l'application ou l'objet je n'arrive pas à savoir d'où ça vient.

merci de votre aide

Voilà le corrigé:

Sub MAJListe()
    'Call ProtVBA
    'mise àjour des valeur conditionnelle si non présent dans la liste finale
    Dim Fc  As Worksheet, Fo As Worksheet
    Dim ln As Long, lnC As Long, lnO As Long, Dl As Long, i As Long, NbreLigneMax As Long
    Dim ClnM As String
    Dim x As Range

    Set Fc = WsRlv 'feuille_cible
    Set Fo = WsB 'feuille_origine
    lnC = 6 'n°_première_ligne_cible
    lnO = 9 'n°_première_ligne_origine
    ClnM = Fo.Range("E6").Value ' colonne du mois
    For i = lnO To Fo.Range("A8").End(xlDown).Row
        Dl = Fc.Range("A" & Rows.Count).End(xlUp).Row
        If Application.WorksheetFunction.CountIf(Fc.Range("A6:A" & Dl), Fo.Range("A" & i)) = 0 Then
            ln = lnC
            Do While Fc.Range("A" & ln) <> ""
                ln = ln + 1
            Loop
            Fc.Range("A" & ln) = Fo.Range("A" & i)
            Fc.Range("N" & ln) = Fo.Range("B" & i)
            Fc.Range("O" & ln) = Fo.Range("C" & i)
            Fc.Range(ClnM & ln) = Fo.Range("D" & i)
        Else
            With Fc.Range("A5:A" & Dl)
                Set x = .Find(Fo.Range("A" & i), lookat:=xlWhole)
                Fc.Cells(x.Row, ClnM) = Fo.Range("D" & i)
            End With
        End If
    Next i

    'Suppression des lignes vides
    NbreLigneMax = Cells(Rows.Count, 1).End(xlUp).Row
    For i = NbreLigneMax To 7 Step -1
        If Fc.Range("A" & i).Value = "" Then
            Rows(i).EntireRow.Delete
        End If
    Next
End Sub

Cdlt

Bonjour,

ça marche. merci infiniment pour la réaction.

J'ai pu finir mon fichier.

Merci ;)