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

Résolu
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. 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. 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. 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. 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. @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. Ca marche parfaitement, bravo vraiment. Et merci d'avoir répondu aussi vite.

      Merci encore.
      0
  2. Re,

    J'aurais bien mis +10 mais je peux pas...
    0
    1. 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. 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. 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. 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