Inserrer des lignes et copier coller les valeurs de la ligne

Bonjour

je ne connais pas grand chose en macro

si vous pouvez m'aider svp

je souhaiterai

- insérer des lignes en autant de fois que la valeur de ma colonne AW ( en dessous chaque ligne de référence)

Si valeur =0 pas d'insertion

Si insertion

• copier coller dans les lignes insérées les valeurs de ma ligne du dessus colonne de A à H
• Transposer mes lignes Q à X dans la ligne insérée
• Transposer mes lignes Y à AF dans la ligne insérée suivante
• Transposer mes lignes AG à AN dans la insérer suivante
• Transposer mes lignes AO à AV dans la ligne insérée suivante

je vous transmets un fichier

Onglet 1 le tableau source sur lequel la macro devra être exécutée

Onglet 2 juste pour vous montrer le résultat attendu

merci d'avance pour votre aide

Bonjour,

Voilà une solution à mettre sur un bouton.

Sub insertion()
Dim Cont As Range

Derlig = Range("A" & Rows.Count).End(xlUp).Row
    For Each cel In Range("A2:A" & Derlig)
        r = cel.Row
        NbI = Range("AW" & r).Value - 1
            If NbI <> "" Or NbI <> 0 Then
                For i = 1 To NbI
If i = 1 Then Set Cont = Range("Q" & r & ":X" & r)
If i = 2 Then Set Cont = Range("Y" & r & ":AF" & r)
If i = 3 Then Set Cont = Range("AG" & r & ":AN" & r)
If i = 4 Then Set Cont = Range("AO" & r & ":AV" & r)

                    Rows(r + 1).Insert Shift:=xlDown
                    Range("A" & r & ":H" & r).Copy
                    Range("A" & r + 1 & ":H" & r + 1).PasteSpecial
                    Cont.Copy
                    Range("I" & r + 1 & ":P" & r + 1).PasteSpecial
                Next i
            End If
        Range("AW" & r).ClearContents
    Next cel

End Sub

A plus !

Super, merci

ça répond exactement a mes besoins