Macro transfert données d'une feuille à l'autre si non existant

Bonjour à tous,

Dans le cadre d'analyse de retards matières lors de fin de projets, j'aurais besoin de votre aide pour pouvoir créer une macro qui puisse transférer des données de la feuille 1 vers un tableau en feuille 2, les données sont les suivantes :

Je cherche, en ayant un nom de projet et un retard liés à chaque bloc matière, pouvoir identifier ces retards en les ajoutant en feuille 2 où j'ai créé un tableau avec pour chaque colonne, la catégorie de matière. Je voudrais que cette macro puisse repérer si les matières pour ce nom de projet ont déjà été ajoutées, et sinon, créer une nouvelle ligne en insérant en feuille 2 au dessus de la ligne en rouge, pour chaque matière en retard de la feuille 1 : le nom de projet, le nom du bloc matière (celui en gras) et le retard.

Merci d'avance pour votre aide

Bonjour

Une proposition PowerQuery + TCD/GCD basé sur la requête (sans VBA)

Quand la source évolue : Données, Actualiser Tout

Merci pour la proposition en Power query, mais je préfèrerais une macro pour pouvoir transférer ces données pour chaque nouveau projet que je vais importer dans des nouvelles feuilles.

J'ai tenté un code ici mais je n'arrive pas à avoir un résultat concluant.

J'ai modifié légèrement les données et ce sont les données des retards liées aux différentes taches des blocs (les lignes non en gras) que je souhaite transférer vers l'autre feuille (nom de projet, nom de tache & retard associé)

Bonsoir JMD546

Avec quelques petites modifications, voici le fichier

Dis nous

Bonsoir BrunoM45

Merci beaucoup pour ta proposition, est-il possible de pouvoir dissocier les types de matières sur différentes colonnes comme j'avais créé dans l'exemple? Je voudrait avoir cette vue pour checker les matières séparément, j'ai au total une dizaine de blocs de suivi différents et ce serait plus lisible pour moi.

J'ai juste un point sur ton code, c'est la vérification de l'existant qui semble ne pas fonctionner, je peux réajouter les retards matières à l'infini à la suite.

Bonjour JMD546

Désolé, comme j'ai ajouté une colonne la fonction de recherche ne fonctionne plus, il faut modifier la colonne de recherche

Function PMETFind(sPMET As String)
  Dim RngF As Range
  With Sheets("Retards moyen matieres")
    Set RngF = .Columns("C:C").Find(What:=sPMET, LookIn:=xlValues, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False)
    If RngF Is Nothing Then
      PMETFind = .Range("B" & Rows.Count).End(xlUp).Row + 1
    Else
      PMETFind = 0 ' Ne pas créer de nouvelle ligne
   End If
  End With
End Function

En mode pas à pas (F8) c'est simple à voir

En ce qui concerne de dissocier les matières, je ne m'aventurerai pas dans ce domaine

J'ai quand même tenté l'expérience de dissocier la matière avec une partie de ton code et en essayant un select case.

J'ai 2 soucis, le premier, c'est que je ne sais pas comment intégrer dans le code le repérage de la dernière ligne pour chaque tableau matière.

Le second, c'est que mon code ne fonctionne pas vraiment.

J'ai finalement réussi à faire ce que je voulais.

Le code si jamais ça intéresse quelqu'un pour un projet similaire :

Sub export_test()
Dim DerLigne, I, J, Dlig1, Dlig2
Dim R1, R2, R3, R4, R5, R6, R7, R8
Dim Task As String, Nom As String

Nom = Cells(2, 2) 'Nom du projet' 'Nom du projet'

Dlig1 = Sheets("Retards moyen matieres").Range("A" & Rows.Count).End(xlUp).Row
Dlig2 = Sheets("Retards moyen matieres").Range("I" & Rows.Count).End(xlUp).Row
DerLigne = Sheets(Nom).Range("B" & Rows.Count).End(xlUp).Row
For I = 2 To DerLigne
If Cells(I, 3).Font.Color = RGB(112, 173, 71) And Cells(I, 6).Value > 0 Then
Dlig1 = Dlig1 + 1
Sheets("Retards moyen matieres").Range("A" & Dlig1) = Sheets(Nom).Range("B" & I)
Sheets("Retards moyen matieres").Range("C" & Dlig1) = Sheets(Nom).Range("C" & I)
Sheets("Retards moyen matieres").Range("D" & Dlig1) = Sheets(Nom).Range("F" & I)
Sheets(Nom).Range("J" & I) = "Retard exporté"

End If
Next I
For J = 2 To DerLigne
If Cells(J, 3).Font.Color = RGB(255, 0, 0) And Cells(J, 6).Value > 0 Then
Dlig2 = Dlig2 + 1
Sheets("Retards moyen matieres").Range("I" & Dlig2) = Sheets(Nom).Range("B" & J)
Sheets("Retards moyen matieres").Range("J" & Dlig2) = Sheets(Nom).Range("C" & J)
Sheets("Retards moyen matieres").Range("L" & Dlig2) = Sheets(Nom).Range("F" & J)
Sheets(Nom).Range("J" & J) = "Retard exporté"
End If
Next J
End Sub