Insérer plusieurs lignes à des indices variables

Bonjour à tous,

Je vous explique mon problème le plus simplement possible je l'espère. Un fichier exemple est joint.

Mon fichier comporte deux feuilles, Feuil1 et Feuil2. J'ai une Liste1 contenant une trentaine de valeurs, chaque valeur est une catégorie, et une Liste2 contenant le numéro de lignes des catégories dans Feuil1.

Mon but est de coller dans Feuil1, en dessous de chaque catégorie correspondante (la position où coller provient de Liste2), s'il y a assez de lignes disponibles, les infos de cette catégorie contenue dans Feuil2.

Par exemple : Je prends la première valeur de ma liste de catégories : 31. Je compte le nombre de lignes de Feuil2 associées à la catégorie 31 que je dois copier, et je teste dans Feuil1 s'il y a assez de lignes entre cette catégorie et la catégorie suivante (grâce à Liste2) pour coller toutes lignes. S'il en manque, j'ajoute le nombre de lignes suffisant. Je colle ensuite les lignes de Feuil2 dans Feuil1 en-dessous de la ligne avec le nom 31, à la position donnée dans Liste2.

J'ai donc besoin d'une boucle For pour le faire pour chaque élément de ma Liste, et c'est là que ma syntaxe pèche je pense. Voici mon code :

    'C'est dans la colonne A de la Feuil2" que se situent les numéros de catégorie
    Set myRange = Worksheets("Feuil2").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

    For i = 0 To 29
        'Si pas assez de lignes dans Feuil1, en insérer suffisamment

        If Application.WorksheetFunction.CountIfs(myRange, Liste1(i)) < (Liste2(i + 1) - Liste2(i) - 1) Then

            'on insère 5 lignes en plus pour la lisibilité

            ValDebut = Liste2(i) + 1
            ValFin = Liste2(i) + Application.WorksheetFunction.CountIfs(myRange, Liste1(i)) - Liste2(i + 1) + Liste2(i) + 1 + 5
            Worksheets("Feuil1").Rows("ValDebut:ValFin").Insert xlShiftDown

        'Copier les lignes de la catégorie et les coller en dessous du nom de catégorie correspondant dans Feuil 1
        For j = 0 To Worksheets("Feuil2").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

            If ThisWorkbook.Sheets("Feuil2").Range("A" & j).Value = Liste1(i) Then
                Sheets("Feuil2").Rows(j).Copy Sheets("Feuil1").Range("A & Liste1(i) : AZ & Liste1(i)")

            End If
        Next j

        End If

    Next i

Je vous remercie et vous souhaite une bonne journée !

Bonjour,
Une proposition à analyser.
Réalisée avec Power Query.
Cdlt.

Bonjour Jean-Eric,

Merci pour votre proposition, malheureusement je dois pouvoir écrire ce programme en VBA car il s'articule dans une macro plus grande, et que je ne veux pas devoir adapter le programme en fonction du nombre d'input.

Cordialement,

Madben