Boucle avec condition et cellules discontinues

Bonjour à tous,

Je débute et bute sur un problématique de boucle avec condition à l'intérieur.

J'ai deux fichiers, un source et un de destination. Je dois copier coller des codes Groupe, TestA, TestB en colonne I selon des éléments de la colonne H dans deux colonnes distinctes de mon fichier de destination.

Je boucle sur chaque éléments de la colonne jusqu'au bout pour copier. En sachant, que je peux avoir des cellules complétés en discontinues.
Et selon la condition je colle dans des colonnes de destination différentes.

Si le contenu de la cellule enseigne = groupe ou TestA
Je colle l’élément dans la cellule NuméroTestA du fichier de destination

Sinon si le contenu de la cellule = TestB
Alors je colle l'élément dans la cellule NuméroTestB du fichier de destination

Vous trouverez ci-joint les fichiers de test.

Merci d'avance.

Je vois que mon post vous laisse sans voix !

Je me suis peut-être mal exprimé dans ma demande, n'hésitez pas à me dire si c'est trop peu clair.

Salut,

Ton Zip est vide apparemment.

Merci Jean-Paul !

J'ai mis à jour le fichier ZIP.

Salut le fil

J'ai modifier un peu ton code pour t'indiquer le fil à suivre, bien entendu il n'est pas abouti.

' // IL EST FORTEMENT CONSEILLE DE NOTER L'OPTION EXPLICIT
' // ET DE FAIRE UNE COMPILATION AVANT DE LANCER LA PROCEDURE
Option Explicit
Sub copier_coller_FichierExtract()

' // Utilises des constantes pour éviter de modifier ton code à plusieurs endroits au cas où
' // Tu remarqueras les majuscules et Underscore pour les diférencier
Const TABLEAU_SOURCE_NAME = "TableSource"
Const LIGNE_A_SUPPRIMER = 1
Const FILE_SOURCE_FULL_PATH = ""
Const CONDITION_NAME = "Condition"
Const PERIMETRE_PRODUIT = " Périmètre Produit"
Const ENSEIGNE_NAME = "Enseigne"

    'Variable du fichier Source Extract
    ' // J'ai modifier le nom de tes variables. Utiles plutôt les UnderScore pour les constantes
Dim wkFichierSource As Workbook
Dim wsSourcefeuil1 As Worksheet

    'Variable du fichier de destination FHC
Dim wkfichierDest As Workbook
Dim wsDestfeuil1 As Worksheet

    ' // On dimensionne le ListObject
Dim lstObjSource As ListObject

    'définir les variables fichiers et objets
    Set wkfichierDest = ActiveWorkbook
    Set wsDestfeuil1 = wkfichierDest.Worksheets("Feuil1")

    'Ouverture du fichier Source
    Set wkFichierSource = Application.Workbooks("Fichier Source.xlsx")    'Application.Workbooks.Open("C:\Users\")    'Adresse à modifier
    Set wsSourcefeuil1 = wkFichierSource.Worksheets("Feuil1")

    'Suppression de la ligne A1
    wsSourcefeuil1.Cells(LIGNE_A_SUPPRIMER, 1).EntireRow.Delete

    '// Création du tableau et assignation du ListObject
    Set lstObjSource = wsSourcefeuil1.ListObjects.Add( _
                       xlSrcRange, wsSourcefeuil1.Range("$A$1:$I$6"), , _
                       xlYes).Name = TABLEAU_SOURCE_NAME

    ' // On assigne le ListObject

    ' // Maintenant tu va pouvoir travailler avec ton ListObject
    Dim Element As Range    ' // Pour boucler sur toutes les plages de ton tableau
    Dim lngRow As Long    ' // Pour l'incrémentation des lignes du tableau destination
    lngRow = 2

    ' // Le fait d'utiliser le DataBodyRange de ton ListObject va te permettre de simplifier ton code
    For Each Element In lstObjSource.ListColumns(ENSEIGNE_NAME).DataBodyRange    ' // DataBodyRanre corresponds à la colonne sans les titres
    ' // A partir d'ici tu vas pouvoir faire tes conditions comme tu le souhaites
        If UCase(Element.Value) = "GROUPE" Or UCase(Element.Value) = "TESTA" Then    ' // si le contenu de la cellule enseigne = groupe ou TestA
            wsDestfeuil1.Range("D" & lngRow).Value = Element.Value
            lngRow = lngRow + 1

        ElseIf UCase(Element.Value) = "TESTN" Or UCase(Element.Value) = "TESTB" Then    ' // sinon si le contenu de la celulle = TestN

            wsDestfeuil1.Range("E" & lngRow).Value = Element.Value
            lngRow = lngRow + 1

        End If

    Next

    '
    'Enregistrer et fermer fichier Source
    'wkFichierSource.Close SaveChanges:=False

End Sub

Bonne prog.

Merci beaucoup Jean-Paul pour tes précisions !

Je faire les modifications.