Insérer un mot

Bonjour tout le monde

J'ai une longue liste de données que je veux mettre en colonne en utilisant le code ci après.

Mais le souci c'est qu'il faut qu’on insère un "mot" ou ligne entière contenant une valeur

pour avoir un nombre de ligne exacte pour que ce code marche.

Le "mot" ici remplace l'information manquant.

Le résultat voulu est dans la feuille 2 après qu'on exécute le code.

J'ai déjà essayé quelquechose mais ça paraît un peu absurde.

Merci de l'aide si quelqu'un peut proposer.

Je n'oublierai pas de cocher la case.

    Sub excelmacro()
    Application.ScreenUpdating = False
    Sheets("Feuil1").Select
    Range("A1").Select

    Sheets("Feuil2").Select
    Range("A2").Select
    For I = 1 To 8
    Sheets("Feuil1").Select
    If ActiveCell.Value <> "" Then

    xnom = ActiveCell.Value
    xprix1 = ActiveCell.Offset(1, 0).Value
    xprix2 = ActiveCell.Offset(2, 0).Value
    xdate = ActiveCell.Offset(3, 0).Value
    xheure = ActiveCell.Offset(4, 0).Value
    xID = ActiveCell.Offset(5, 0).Value
    xclient = ActiveCell.Offset(6, 0).Value
    xinfo1 = ActiveCell.Offset(7, 0).Value
    xinfo2 = ActiveCell.Offset(8, 0).Value

    Sheets("Feuil2").Select
    ActiveCell.Value = xnom
    ActiveCell.Offset(0, 1).Value = xprix1
    ActiveCell.Offset(0, 2).Value = xprix2
    ActiveCell.Offset(0, 3).Value = xdate
    ActiveCell.Offset(0, 4).Value = xheure
    ActiveCell.Offset(0, 5).Value = xID
    ActiveCell.Offset(0, 6).Value = xclient
    ActiveCell.Offset(0, 7).Value = xinfo1
    ActiveCell.Offset(0, 8).Value = xinfo2
    ActiveCell.Offset(1, 0).Select
    Sheets("Feuil1").Select
    ActiveCell.Offset(9, 0).Select
    Else
        I = 10
    End If
    I = I - 1
    Next
    Application.ScreenUpdating = True
    End Sub

bonjour,

une proposition

Sub aargh()
    Set ws1 = Sheets("feuil1")
    Set ws2 = Sheets("feuil2")
    dl = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    i = 1
    k = 1
    While i <= dl
        ws1.Cells(i, 1).Resize(7).Copy
        k = k + 1
        ws2.Cells(k, 1).PasteSpecial Transpose:=True
        i = i + 8
        j = 7
        While ws1.Cells(i, 1) <> ""
            j = j + 1
            ws2.Cells(k, j) = ws1.Cells(i, 1)
            i = i + 1
        Wend
        i = i + 1
    Wend
End Sub

Merci, ça marche!