[Macro permettant d'afficher les différents projets d'un age

Bonjour,

j'ai un gros souci avec ma macro. Merci de m'aider à la faire marcher.

Contexte : J'ai un planning qui sur chaque ligne a comme données d'entrée les initiales du projet, les agents puis j'ai une zone calendaire (découpage en démi semaine sur 2 ans ) qui me permet d'affecter le numéro des agents pour chaque tâche/ligne créée)

Pbm1 : Le code en l'état actuel me met "Erreur d'exécution 13"

Pbm2 : Comment se servir des listes créées dans le gestionnaire de noms dans mon code VBA, puisque j'ai tableau planning dont les lignes s'incrémentent au fur et à mesure d'où la nécessité d'avoir une déclaration ne prenant pas en compte les repères Excel

Voici le code que j'ai rédigé

Option Explicit

Option Base 1

Sub PlanningAgent()

Dim NomAgents() As Variant

Dim Planning() As Variant

Dim TestPlanning() As Variant

Dim AgentsPlanning() As Variant

Dim InitialesProjets() As Variant

Dim H As Byte

Dim I As Byte

Dim J As Byte

'Récupération de données

NomAgents = Sheets("Listes").Range("Q3:Q18")

Planning = Sheets("Planning_PR").Range("S8:HR29")

AgentsPlanning = Sheets("Planning_PR").Range("R8:R29")

InitialesProjets = Sheets("Planning_PR").Range("B8:B29")

ReDim TestPlanning(UBound(NomAgents, 1), UBound(Planning, 2))

'Rechercher les projets de chaque Agent par demi-semaine de planning

For H = 1 To UBound(Planning, 2)

For I = 1 To UBound(NomAgents, 1)

For J = 1 To UBound(Planning, 1)

If ((Planning(J, H) <> 0) And (AgentsPlanning(J, H) = NomAgents(I))) Then

TestPlanning(I, H) = InitialesProjets(J, 1) & TestPlanning(I, H)

End If

Next J

Next I

Next H

'Afficher les valeurs trouvées dans le fichier prévu

Sheets("Planning_Ag").Select

Sheets("Planning_Ag").Range("C8:HB22") = TestPlanning

'Effacer les données du tableau

Erase TestPlanning

End Sub

Bonjour et bienvenu(e)

Pour la 1ère question

A tester

  For H = 1 To UBound(Planning, 2)
    For I = 1 To UBound(NomAgents, 1)
      For J = 1 To UBound(Planning, 1)

        If ((Planning(J, H) <> 0) And (AgentsPlanning(J, H) = NomAgents(I, 1))) Then
          TestPlanning(I, H) = InitialesProjets(J, 1) & TestPlanning(I, H)
        End If

      Next J
    Next I
  Next H

Pour ta 2ème question un fichier serait pratique dans lequel tu indiques ce que tu as et ce que tu veux

Merci Banzai64!

J'ai pris en compte ta correction et j'ai rajouté quelques lignes, je pense que ç'est réglé pour l'affectation des valeurs.

Mon code se bloque à présent sur la boucle If, j'ai comme message d'erreur "Erreur d'exécution 9, l'indice n'appartient pas à la sélection.

Quelqu'un a une idée???

Option Explicit

Option Base 1

Sub PlanningAgent()

Dim NomAgents() As Variant

Dim Planning() As Variant

Dim TestPlanning() As Variant

Dim AgentsPlanning() As Variant

Dim InitialesProjets() As Variant

Dim H As Integer

Dim I As Integer

Dim J As Integer

'Supprimer le contenu du planning Agents

ThisWorkbook.Worksheets("Planning_A").Range("rPlanningAgent").ClearContents

'Récupération de données

NomAgents = ThisWorkbook.Names("rAgentNom").RefersToRange.Value

Planning = ThisWorkbook.Names("rPlanning").RefersToRange.Value

AgentsPlanning = ThisWorkbook.Names("rPngAgent").RefersToRange.Value

InitialesProjets = ThisWorkbook.Names("rInitialesProjets").RefersToRange.Value

ReDim TestPlanning(UBound(NomAgents, 1), UBound(Planning, 2))

'Rechercher les projets de chaque Agent par demi-semaine de planning

For H = 1 To UBound(Planning, 2)

For I = 1 To UBound(NomAgents, 1)

For J = 1 To UBound(Planning, 1)

If ((Planning(J, H) <> 0) And (AgentsPlanning(J, H) = NomAgents(I, 1))) Then

TestPlanning(I, H) = InitialesProjets(J, 1) & TestPlanning(I, H)

End If

Next J

Next I

Next H

'Afficher les valeurs trouvées dans le fichier prévu

ThisWorkbook.Worksheets("Planning_A").Select

ThisWorkbook.Worksheets("Planning_A").Range("rPlanningAgent") = TestPlanning

'Effacer les données du tableau

Erase TestPlanning

End Sub

Bonjour

Ok, le voici

Bonsoir

Je ne sais pas si c'est la solution mais ton tableau AgentsPlanning est un tableau à une seule colonne, comme le tableau NomAgents

Modifies ton code

  For H = 1 To UBound(Planning, 2)
    For I = 1 To UBound(NomAgents, 1)
      For J = 1 To UBound(Planning, 1)
        If ((Planning(J, H) <> 0) And (AgentsPlanning(J, 1) = NomAgents(I, 1))) Then
          TestPlanning(I, H) = InitialesProjets(J, 1) & TestPlanning(I, H)
        End If
      Next J
    Next I
  Next H

Merci Banzai64,

Tu as raison, mon code marche à présent parfaitement!!!