Code qui ne s'exécute pas jusqu'au bout

Résolu
Kuartz -  
Bonjour,

Mon code (pas du tout optimisé) : 

Sub Macro_TEST()
Dim DL As Long

DL = Range("B65000").End(xlUp).Row


For i = 13 To DL
Compte = CStr(Sheets(1).Range("B" & i).Value)
Compte_1 = CStr(Sheets(1).Range("B" & i - 1).Value)

If Compte = "40301000" Then
    If Compte_1 <> "40301000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End If


If Compte = "40302000" Then
    If Compte_1 <> "40302000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40303000" Then
    If Compte_1 <> "40303000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40304000" Then
    If Compte_1 <> "40304000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40305000" Then
    If Compte_1 <> "40305000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40306000" Then
    If Compte_1 <> "40306000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40307000" Then
    If Compte_1 <> "40307000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40308000" Then
    If Compte_1 <> "40308000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40309000" Then
    If Compte_1 <> "40309000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40310000" Then
    If Compte_1 <> "40310000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40311000" Then
    If Compte_1 <> "40311000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40312000" Then
    If Compte_1 <> "40312000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


Next i


End Sub


Allez comprendre, les lignes se créent bien au dessus des 40301000, puis au dessus des 40302000 puis au dessus.... etc par contre arrivé à 40308000, le code n'a pas créé de ligne. Certes, il y a beaucoup plus de 40307000 mais quand même ! Le code devrait aller jusqu'à la fin de la feuille !

Merci d'avance.

Cordialement.

5 réponses

  1. Frenchie83
    Bonjour
    Sauf erreur de ma part, le problème c'est que DL est fixé au départ, or il évolue au fur et à mesure qu'on insère des lignes, comme on rajoute 3 lignes à chaque insertion, il faut donc multiplier DL par 3 
    Sub Macro_TEST()
    Dim DL As Long
    DL = Range("B65000").End(xlUp).Row
    For i = 13 To DL * 3
        Compte = CStr(Sheets(1).Range("B" & i).Value)
        Compte_1 = CStr(Sheets(1).Range("B" & i - 1).Value)
        If Compte = "40301000" And Compte_1 <> "40301000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40302000" And Compte_1 <> "40302000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40303000" And Compte_1 <> "40303000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40304000" And Compte_1 <> "40304000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40305000" And Compte_1 <> "40305000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40306000" And Compte_1 <> "40306000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40307000" And Compte_1 <> "40307000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40308000" And Compte_1 <> "40308000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40309000" And Compte_1 <> "40309000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40310000" And Compte_1 <> "40310000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40311000" And Compte_1 <> "40311000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40312000" And Compte_1 <> "40312000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
    Next i
End Sub

    A esayer
    Cdlt
    1
    1. Kuartz Auteur
      D'autant plus que si je relance le code, il continue sur les 40309000 puis s'arrête. Puis je le relance et là il va jusqu'à la fin..

      Merci de votre aide.
      0
      1. ThauTheme
        Bonjour Kuartz, bonjour le forum,

        Peut-être on pourrait simplifier le code code ça : 

        Sub Macro_TEST()
Dim DL As Long
Dim Compte As String
Dim Compte_1 As String
Dim I As Long
Dim J As Long
Dim K As Long

DL = Range("B65000").End(xlUp).Row
For I = 13 To DL
    Compte = CStr(Sheets(1).Range("B" & I).Value)
    Compte_1 = CStr(Sheets(1).Range("B" & I - 1).Value)
    For J = 1000 To 9000 Step 1000
        If Compte = "4030" & CStr(J) Then
            If Compte <> Compte_1 And Compte_1 <> "" Then
                Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
    Next J
    For K = 10000 To 12000 Step 1000
        If Compte = "403" & CStr(K) Then
            If Compte <> Compte_1 And Compte_1 <> "" Then
                Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
    Next K
Next I
End Sub


        Qu'est-ce que ça donne ?

        À plus,
        ThauTheme
        0
        1. ThauTheme
          Re,

          J'aurais bien mis +10 mais je peux pas...
          0
          1. Frenchie83
            Merci ThauTheme pour l'encouragement, mais notre ami Kuartz n'a visiblement pas lu toutes les réponses, puisque je constate que l'erreur persiste toujours.

            Kuartz, j'ai donné une réponse un peu plus haut qui est peut-être la solution à vos problèmes.
            Cdlt
            0
        3. Kuartz Auteur
          C'est vraiment bizarre ca ne marche pas....

          Je vais tenter de vous envoyer le fichier via Cjoint.

          Par contre, je vais vous donner le code exact, le problème est que si j'ai un 40301000 ou un 40302000, les actions à réaliser ne sont vraiment pas les mêmes.

          Voici mon code final (qui ne marche pas sauf si je le répète plusieurs fois) : 

          Sub Macro_TEST()
Dim DL As Long

DL = Range("B65000").End(xlUp).Row


For I = 13 To DL
Compte = CStr(Sheets(1).Range("B" & I).Value)
Compte_1 = CStr(Sheets(1).Range("B" & I - 1).Value)

If Compte = "40301000" Then
    If Compte_1 <> "40301000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Janvier"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
  End If
End If
End If


If Compte = "40302000" Then
    If Compte_1 <> "40302000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Février"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
    With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40303000" Then
    If Compte_1 <> "40303000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Mars"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40304000" Then
    If Compte_1 <> "40304000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer d'Avril"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
           With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40305000" Then
    If Compte_1 <> "40305000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Mai"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40306000" Then
    If Compte_1 <> "40306000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Juin"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40307000" Then
    If Compte_1 <> "40307000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Juillet"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40308000" Then
    If Compte_1 <> "40308000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Août"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40309000" Then
    If Compte_1 <> "40309000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Septembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
          With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40310000" Then
    If Compte_1 <> "40310000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Octobre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
          With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40311000" Then
    If Compte_1 <> "40311000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Novembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40312000" Then
    If Compte_1 <> "40312000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Décembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If

Next I

End Sub


          Pardon pour la longueur....
          0
          1. Kuartz Auteur
            Fichier anonymé : https://www.cjoint.com/c/EGipcAG1WQf

            Votre macro est en module 4, la mienne en module 5.

            Vous allez constater le problème.

            Edit : Le code pour accéder au VBA : Fretjerome
            0
          2. Kuartz Auteur
            A la limite, je pourrais presque ré-éxécuter le code plusieurs fois à la chaîne étant donné qu'il faut répéter la macro plusieurs fois pour le code ailler jusqu'au bout mais bon.... C'est un peu ridicule...
            0
          3. Frenchie83
            Avez-vous appliquez ce que je vous ai de faire? voir post 6 et 3
            Sur votre fichier, l'accés à vos macros est verrouillé
            0
          4. Kuartz Auteur
            @Frenchie83Je teste immédiatement. (Pardon de ne pas avoir vu votre réponse, je ne comprend pas pourquoi je les vois aussi tardivement à chaque fois...)
            0
          5. Kuartz Auteur
            Ca marche parfaitement, bravo vraiment. Et merci d'avoir répondu aussi vite.

            Merci encore.
            0

        Discussions similaires

        C'est quoi un BILLING ZIP CODE
        bikanane

        1 réponse
        [référencement] Ne pas être référencé
        kij_82

        10 réponses
        Où sont stockés les QR codes sur android ?
        zatox19

        11 réponses