Macro qui bloque

Bonjour,

Je rencontre un problème avec mon fichier excel, que j'avais optimisé avec une macro.

Mon fichier contient toutes les informations de suivi de formation, et j'avais réussi avec de l'aide à faire une macro qui permettait d'actualiser les fiches individuelles suivants les différentes modifications faite sur le tableau de base "RECAP DES AGENTS formation 2021". un bouton "Fiches indiv" a été créé pour la mise à jour des informations.

Or mon responsable est passé par là, et il a modifié tout le tableau en y faisant aussi des rajout de colonnes etc... bref un vrai bordel.

Du coup ma macro ne fonctionne plus et évidemment il souhaite que tout soit de nouveau fonctionnel.

J'ai donc essayé de recréer la macro en supprimant l'ancienne, mais rien ne fonctionne.

Seriez-vous me dire où est mon erreur ? voici la macro utilisée :

Option Explicit

Dim fRec As Worksheet, f As Worksheet, tablo, tabloF

Dim fa As Worksheet, dico As Object

Dim i&, j&, lgn&, col&, form$

Sub FichesIndividuelles()

Application.ScreenUpdating = False

Set fRec = Sheets("RECAP DES AGENTS formation 2021")

tablo = fRec.Range("A1").CurrentRegion

Set dico = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(tablo, 1)

dico(tablo(i, 1)) = ""

Next i

Application.DisplayAlerts = False

For Each f In Worksheets

If dico.exists(f.Name) Then

Sheets(f.Name).Delete

End If

Next f

Application.DisplayAlerts = True

Sheets("Modèle").Visible = True

For i = 3 To UBound(tablo, 1)

Sheets("Modèle").Select

Sheets("Modèle").Copy after:=Sheets(Sheets.Count)

ActiveSheet.Name = tablo(i, 1)

Set fa = ActiveSheet

fa.Range("C2") = tablo(i, 1)

For j = 2 To UBound(tablo, 2)

If tablo(i, j) <> "" And tablo(2, j) = "Dernier R" Then

form = tablo(1, j)

lgn = fa.Range("C" & Rows.Count).End(xlUp)(2).Row

fa.Range("C" & lgn) = form

fa.Range("C4:E4").Copy

Cells(lgn, 3).PasteSpecial xlPasteFormats

fa.Cells(lgn, 4) = tablo(i, j)

fa.Cells(lgn, 5) = tablo(i, j + 1)

fa.Cells(lgn, 4).Interior.Color = fRec.Cells(i, j).DisplayFormat.Interior.Color

fa.Cells(lgn, 5).Interior.Color = fRec.Cells(i, j + 1).DisplayFormat.Interior.Color

ElseIf tablo(i, j) <> "" And tablo(i, j - 1) = "" And tablo(2, j) = "Prochain R" Then

form = tablo(1, j - 1)

lgn = fa.Range("C" & Rows.Count).End(xlUp)(2).Row

fa.Range("C" & lgn) = form

fa.Range("C4:E4").Copy

Cells(lgn, 3).PasteSpecial xlPasteFormats

fa.Cells(lgn, 4) = tablo(i, j - 1)

fa.Cells(lgn, 5) = tablo(i, j)

fa.Cells(lgn, 4).Interior.Color = fRec.Cells(i, j - 1).DisplayFormat.Interior.Color

fa.Cells(lgn, 5).Interior.Color = fRec.Cells(i, j).DisplayFormat.Interior.Color

End If

Next j

Next i

Sheets("Modèle").Visible = False

fRec.Activate

Application.CutCopyMode = False

MsgBox "Les fiches ont été recréées et mises à jour."

End Sub

Je vous joins aussi si besoin mon fichier excel.

Merci d'avance pour votre aide.

Julie

Bonjour

j'avais réussi avec de l'aide à faire une macro qui permettait d'actualiser les fiches individuelles suivants...

Pourrais-tu joindre ce fichier initial ?

Bye !

Bonjour gmb,

Voici le fichier initial.

bonjour,

adaptation de la macro basée sur ton premier fichier

Option Explicit
Dim fRec As Worksheet, f As Worksheet, tablo, tabloF
Dim fa As Worksheet, dico As Object
Dim i&, j&, lgn&, col&, form$

Sub FichesIndividuelles()

    Application.ScreenUpdating = False
    Set fRec = Sheets("RECAP DES AGENTS formation 2021")
    tablo = fRec.Range("A1").CurrentRegion
    Set dico = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo, 1)
        dico(tablo(i, 1)) = ""
    Next i
    Application.DisplayAlerts = False
    For Each f In Worksheets
        If dico.exists(f.Name) Then
            Sheets(f.Name).Delete
        End If
    Next f
    Application.DisplayAlerts = True
    Sheets("Modèle").Visible = True
    For i = 4 To UBound(tablo, 1)
        Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = tablo(i, 1)
        Set fa = ActiveSheet
        fa.Range("C2") = tablo(i, 1)
        For j = 2 To UBound(tablo, 2)
            If tablo(i, j) <> "" And tablo(3, j) = "Dernier R" Then
                form = tablo(2, j)
                lgn = fa.Range("C" & Rows.Count).End(xlUp)(2).Row
                fa.Range("C" & lgn) = form
                fa.Range("C4:E4").Copy
                Cells(lgn, 3).PasteSpecial xlPasteFormats
                fa.Cells(lgn, 4) = tablo(i, j)
                fa.Cells(lgn, 5) = tablo(i, j + 1)
                fa.Cells(lgn, 4).Interior.Color = fRec.Cells(i, j).DisplayFormat.Interior.Color
                fa.Cells(lgn, 5).Interior.Color = fRec.Cells(i, j + 1).DisplayFormat.Interior.Color
            ElseIf tablo(i, j) <> "" And tablo(i, j - 1) = "" And tablo(3, j) = "Prochain R" Then '<- vérifier cette condition
                form = tablo(2, j - 1)
                lgn = fa.Range("C" & Rows.Count).End(xlUp)(2).Row
                fa.Range("C" & lgn) = form
                fa.Range("C4:E4").Copy
                fa.Cells(lgn, 3).PasteSpecial xlPasteFormats
                fa.Cells(lgn, 4) = tablo(i, j - 1)
                fa.Cells(lgn, 5) = tablo(i, j)
                fa.Cells(lgn, 4).Interior.Color = fRec.Cells(i, j - 1).DisplayFormat.Interior.Color
                fa.Cells(lgn, 5).Interior.Color = fRec.Cells(i, j).DisplayFormat.Interior.Color
            End If
        Next j
    Next i
    Sheets("Modèle").Visible = False
    fRec.Activate
    Application.CutCopyMode = False
    MsgBox "Les fiches ont été recréées et mises à jour."
End Sub

Bonjour,

La macro semble bien fonctionner chez moi ... Mais je n'ai pas vérifié tout dans le détail.

Après, quel est l'intérêt d'avoir un onglet par personne ?
Perso, je n'aurais que 2 onglets. Ton onglet principal et un onglet individuel. Une liste déroulante dans l'onglet individuel permettrait de choisir une personne et toutes ses données s'afficheraient. Pas besoin de macro pour ceci en plus.

Bonjour H2so4,

Merci infiniment cela fonctionne

et je vois effectivement ce qui n'allait pas...

Un énorme merci pour cette réussite et la rapidité de ta réponse.

Excellente journée !

Bonjour Joyeux Noel,

je suis tout à fait d'accord avec tes propositions et c'est bien cela que j'avais créé de base. mais ce n'était pas au gout de mon responsable.....

Merci en tout cas.

Bonne journée !