Problème de recopie selon condition VBA

Bonjour,

Je fais appel a vos lumières car je suis coincé sur ma macro depuis ce matin :

Le but étant d'extraire les données de l'onglet données et de les compiler selon le nom dans un onglet unique par agent.

Lequel onglet est une copie de l'onglet modèle incrémenté des données.

Le problème réside dans le fait que ma copie ce décale au fur et a mesure des agents.

Si quelqu'un a une soluce pour éviter ce décalage je suis preneur !

merci d'avance !

(ci joint le code et le fichier)

Sub Agent()

Dim oShModele As Worksheet

Dim oShListe As Worksheet

Dim iLigFin As Integer

Dim iLig As Integer

Dim oShNew As Worksheet

Dim sNomOnglet As String

Set oShModele = Worksheets("Modele")

Set oShListe = Worksheets("Données")

iLigFin = oShListe.Range("C" & Rows.Count).End(xlUp).Row

For iLig = 2 To iLigFin

If oShListe.Range("C" & iLig).Value <> "" Then

sNomOnglet = oShListe.Range("B" & iLig).Value & " " & oShListe.Range("C" & iLig).Value

If OngletExist(sNomOnglet) Then

Set oShNew = Worksheets(sNomOnglet)

Else

oShModele.Copy After:=Worksheets(Worksheets.Count)

Worksheets(Worksheets.Count).Name = sNomOnglet

Set oShNew = Worksheets(Worksheets.Count)

End If

oShNew.Range("A" & iLig).Value = oShListe.Range("A" & iLig).Value 'code agent

oShNew.Range("B" & iLig).Value = oShListe.Range("B" & iLig).Value 'Nom

oShNew.Range("C" & iLig).Value = oShListe.Range("C" & iLig).Value 'Prénom

oShNew.Range("D" & iLig).Value = oShListe.Range("D" & iLig).Value 'Date roulement

oShNew.Range("E" & iLig).Value = oShListe.Range("E" & iLig).Value 'service

oShNew.Range("F" & iLig).Value = oShListe.Range("F" & iLig).Value 'heure début

oShNew.Range("G" & iLig).Value = oShListe.Range("G" & iLig).Value 'heure fin

oShNew.Range("H" & iLig).Value = oShListe.Range("H" & iLig).Value 'qualité

oShNew.Range("I" & iLig).Value = oShListe.Range("I" & iLig).Value 'TTE

oShNew.Range("J" & iLig).Value = oShListe.Range("J" & iLig).Value 'TP

oShNew.Range("K" & iLig).Value = oShListe.Range("K" & iLig).Value 'Centre

oShNew.Range("L" & iLig).Value = oShListe.Range("L" & iLig).Value 'Typejours

'lien hypertext

'oShNew.Hyperlinks.Add Anchor:=oShListe.Range("D" & iLig), Address:="", SubAddress:= _

"'" & sNomOnglet & "'!A1", TextToDisplay:=oShListe.Range("D" & iLig).Value

Set oShNew = Nothing

End If

Next iLig

oShListe.Select

Set oShListe = Nothing

Set oShModele = Nothing

End Sub

Private Function OngletExist(psNom As String) As Boolean

Dim oSh As Worksheet

Dim lErr As Long

Dim sErr As String

On Error Resume Next

Set oSh = Worksheets(psNom)

lErr = Err.Number

sErr = Err.Description

On Error GoTo 0

If lErr = 0 Then

OngletExist = True

ElseIf lErr = 9 Then

OngletExist = False

Else

MsgBox "Erreur n°" & lErr & vbCrLf & sErr, vbExclamation

End If

Set oSh = Nothing

End Function

bonjour

le problème : tu utilises ilig pour tes données (dans données) mais tu l'utilises aussi comme variable pour la ligne destination, la ligne est donc copiée sur la feuille destination sur la même ligne que données. Solution utilise une autre variable pour determiner la ligne sur la feuille destination.

proposition de correction de ton code

Sub Agent()

    Dim oShModele As Worksheet
    Dim oShListe As Worksheet
    Dim iLigFin As Long
    Dim iLig As Long
    Dim iLigNs As Long
    Dim oShNew As Worksheet
    Dim sNomOnglet As String

    Set oShModele = Worksheets("Modele")
    Set oShListe = Worksheets("Données")

    iLigFin = oShListe.Range("C" & Rows.Count).End(xlUp).Row

    For iLig = 2 To iLigFin
        If oShListe.Range("C" & iLig).Value <> "" Then
            sNomOnglet = oShListe.Range("B" & iLig).Value & " " & oShListe.Range("C" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                oShModele.Copy After:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = sNomOnglet
                Set oShNew = Worksheets(Worksheets.Count)
            End If
            iLigNs = oShNew.Cells(Rows.Count, 1).End(xlUp).Row + 1
            oShNew.Range("A" & iLigNs).Value = oShListe.Range("A" & iLig).Value 'code agent
            oShNew.Range("B" & iLigNs).Value = oShListe.Range("B" & iLig).Value 'Nom
            oShNew.Range("C" & iLigNs).Value = oShListe.Range("C" & iLig).Value 'Prénom
            oShNew.Range("D" & iLigNs).Value = oShListe.Range("D" & iLig).Value 'Date roulement
            oShNew.Range("E" & iLigNs).Value = oShListe.Range("E" & iLig).Value 'service
            oShNew.Range("F" & iLigNs).Value = oShListe.Range("F" & iLig).Value 'heure début
            oShNew.Range("G" & iLigNs).Value = oShListe.Range("G" & iLig).Value 'heure fin
            oShNew.Range("H" & iLigNs).Value = oShListe.Range("H" & iLig).Value 'qualité
            oShNew.Range("I" & iLigNs).Value = oShListe.Range("I" & iLig).Value 'TTE
            oShNew.Range("J" & iLigNs).Value = oShListe.Range("J" & iLig).Value 'TP
            oShNew.Range("K" & iLigNs).Value = oShListe.Range("K" & iLig).Value 'Centre
            oShNew.Range("L" & iLigNs).Value = oShListe.Range("L" & iLig).Value 'Typejours

            'lien hypertext
           'oShNew.Hyperlinks.Add Anchor:=oShListe.Range("D" & iLig), Address:="", SubAddress:= _
                    "'" & sNomOnglet & "'!A1", TextToDisplay:=oShListe.Range("D" & iLig).Value
            Set oShNew = Nothing
        End If
    Next iLig

    oShListe.Select

    Set oShListe = Nothing
    Set oShModele = Nothing

End Sub
Private Function OngletExist(psNom As String) As Boolean

    Dim oSh As Worksheet
    Dim lErr As Long
    Dim sErr As String

    On Error Resume Next
    Set oSh = Worksheets(psNom)
    lErr = Err.Number
    sErr = Err.Description
    On Error GoTo 0

    If lErr = 0 Then
        OngletExist = True
    ElseIf lErr = 9 Then
        OngletExist = False
    Else
        MsgBox "Erreur n°" & lErr & vbCrLf & sErr, vbExclamation
    End If

    Set oSh = Nothing
    End Function
Public Sub SupprFeuilles()

    Dim oSh As Worksheet

    Const S_ONG_MODELE As String = "Modele"
    Const S_ONG_LISTE As String = "Données"

    If MsgBox("Voullez-vous supprimer tous les onglets ?", vbYesNoCancel + vbExclamation) <> vbYes Then
        Exit Sub
    End If

    For Each oSh In Worksheets
        If oSh.Name <> S_ONG_LISTE And oSh.Name <> S_ONG_MODELE Then
            Application.DisplayAlerts = False
        oSh.Delete
            Application.DisplayAlerts = True
        End If
    Next oSh

End Sub

Ça marche nickel ! Merci !