Boucle pour alléger le code

[msingle]

Bonjour,

Je ne parviens pas à créer une boucle pour alléger mon code (Excel me signale que le code dépasse 64k).

Le problème :

J'importe des commandes d'un site ecommerce de tshirts personnalisés.

Chaque commande se trouve sur une ligne, mais peut comporter un nombre variable d'articles (jusqu'à 10).

Je dois donc les "transposer" afin de pouvoir créer un fichier de fabrication comportant 25 champs.

Voici un extrait de mon code :

Sub test()
    'teste si déjà mis en fabrication
        nbrlignes = Application.WorksheetFunction.CountA(Feuil4.Range("$A:$A"))
        ActiveSheet.Range("$A$8:$FJ" & nbrlignes + 7).AutoFilter Field:=166, Criteria1:="=" ' le champ FJ doit être vide
        lastfilterrow = Range(["A65535"]).End(xlUp).Row
        If lastfilterrow > 8 Then 'les données commencent à partir de la ligne 9
    'copie de l'article 1 :
            ActiveSheet.Range("$A$8:$FJ" & nbrlignes + 7).AutoFilter Field:=37, Criteria1:="<>"
            lastfilterrow = Range(["A65535"]).End(xlUp).Row
            Range("S9:S" & Range("S" & Rows.Count).End(xlUp).Row).Copy 'nom
            Sheets("Fabrication").[B65000].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    'copie de l'article 2 :
            ' à chaque changement d'article, on décale le champ à filtrer de 13 colonnes. Dans ce cas, on passe de 37 à 50.
            ActiveSheet.Range("$A$8:$FJ" & nbrlignes + 7).AutoFilter Field:=50, Criteria1:="<>"
            lastfilterrow = Range(["A65535"]).End(xlUp).Row
        If lastfilterrow > 8 Then
            Range("S9:S" & Range("S" & Rows.Count).End(xlUp).Row).Copy 'nom
            Sheets("Fabrication").[B65000].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    'copie de l'article 3 :
            ' on décale de 50 à 63 (+13)
            ActiveSheet.Range("$A$8:$FJ" & nbrlignes + 7).AutoFilter Field:=63, Criteria1:="<>"
            lastfilterrow = Range(["A65535"]).End(xlUp).Row
        If lastfilterrow > 8 Then
            Range("S9:S" & Range("S" & Rows.Count).End(xlUp).Row).Copy 'nom
            Sheets("Fabrication").[B65000].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
' etc., etc.... jusqu'à 10 commandes
End Sub

Pouvez-vous m'aider à créer la boucle qui simplifiera mon code?

Merci d'avance

 

[CPk]

Re : Boucle pour alléger le code

Bonjour, c'est préférable de joindre un fichier avec un exemple de la situation initiale et du résultat attendu.