Recopie cellules sur plusieurs feuilles

Bonjour à tous,

Dans le cadre de la réalisation d'une base de donnée pour mon entreprise je me retrouve confronté à un problème.

Vous m'avez été d'une grande lors de mes précédents messages et j'espère que vous pourrez l'être encore une fois

Je vous explique :

Je souhaiterai copier une colonne sur plusieurs feuilles en fonction de certain critères...

Comme vous pouvez le voir sur le fichier joint je voudrais copier toutes les références notées P sur les feuilles "Annexe 7", "Compliance Matrix" et "Property list".

Mais également recopier toutes les référence en feuille 2 sur la feuille "Annexe 5". Et c'est là que ça se complique

Je voudrais pouvoir trier ces références par type : G pour documentation générale, T pour documents techniques et P pour procédés spéciaux.

Le problème c'est que les cellules des titres sont fusionnées..

Je pense que le fichier joint vous permettra de mieux comprendre ma demande

J'avais déjà codé grâce à votre aide un VBA me permettant de supprimer puis de recopier la liste sur les différentes feuilles mais comme j'ai du rajouter une feuille à remplir automatiquement les conditions de remplissage ont changées comme expliquée plus haut..

Voici le code si cela peut vous aider :

Sub Recopie()

    Application.ScreenUpdating = False
    Set f = Sheets("Annexe 7")
    Set g = Sheets("Compliance Matrix")
    Set h = Sheets("Property list")

    f.Range("A4:A" & Application.Max(4, f.Range("A" & Rows.Count).End(xlUp).Row)).Clear
    g.Range("A6:A" & Application.Max(6, g.Range("A" & Rows.Count).End(xlUp).Row)).Clear
    h.Range("A20:A" & Application.Max(20, h.Range("A" & Rows.Count).End(xlUp).Row)).Clear

    With Sheets("Feuil2")
    i = 5
        Do While Cells(i, 1) <> "Total général"
            .Range(Cells(i, 1), Cells(i, 1)).Copy Destination:=Sheets("Annexe 7").Cells(i - 2, 1)
            .Range(Cells(i, 1), Cells(i, 1)).Copy Destination:=Sheets("Compliance Matrix").Cells(i + 1, 1)
            .Range(Cells(i, 1), Cells(i, 1)).Copy Destination:=Sheets("Property list").Cells(i + 15, 1)

        i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

Si jamais je n'ai pas été assez clair dites moi je reformulerai ma demande

Bonjour à tous

Quelqu'un pour m'aider s'il vous plait ?

J'ai toujours besoin d'aide s'il vous plais