Macro de copie sous condition plante

Bonjour à tous,

J'explique rapidement mon fichier et le but de ma macro

En colonne F j'ai un niveau (de 0 à 7)

En colonne H j'ai un format texte (ref)

En colonne O Je dois récupérer le format texte ( ref) du premier niveau inférieur

JE vous joint un fichier exemple sur ce que je veux.

J'ai donc écrit une macro, parce que avec les fonction SI et Recherche, je me galère assez rapidement.

Voilà ce que j'ai :

Sub PNR_Parent()

Dim i As Long
Dim L As Long
Dim b As Boolean
For L = 6 To 200

 If Cells(L, 6) = 2 Then
    b = False

        For i = 1 To L - 1 
' pour information j'ai essayé i = 1 To L + 1 et i = 1 To 199 et c'est le même constat 
        While b = False

             If Cells(L - i, 6) = 1 Then
             Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
             b = True

             End If

        Wend
        Next i

    b = False

End If

Next L

End Sub

Sauf que je vois que ca fonctionne pour les quelques premier mais après ca plante sans savoir pourquoi (c'est excel qui plante !)

Si quelqu'un à une idée je suis preneur.

Bonsoir

Là tu sembles boucler , ton L et ton i n'évoluent pas

While b = False
                 If Cells(L - i, 6) = 1 Then
                 Cells(L - i, 8).Select
                 Selection.Copy
                 Cells(L, 15).Select
                 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
                 b = True

                 End If

            Wend

Revois ton code de près, bon courage

Bye

Salut jujuchon,

While b = False
    If Cells(L - i, 6) = 1 Then
        '...
    End If
Wend

Si Cells(L-i,6) <> 1, tu boucleras jusqu'à la nuit des temps...

Par ailleurs, ton fichier-exemple n'étant absolument pas conforme à ton code, je ne peux tester valablement. A toi d'adapter.

Dim L As Integer, i As Integer
'
For L = 1 To 200
    If Cells(L, 6) = 2 Then
        For i = 1 To L - 1
            If Cells(L - i, 6) = 1 Then
                Cells(L, 15) = Cells(L - i, 8)
                Exit For
            End If
        Next i
    End If
Next L

A+

Merci

Curulis57, je test la technique demain matin.

Je ne peux malheureusement sortir aucun excel, et j'ai juste construire le fichier excel pour que vous compreniez.

Je vous tiens au courant

Merci encore curulis57 !

J'ai modifié ma macro et ça fonctionne avec ta technique

J'ai toujours un problème avec les Cells(L, 15) = Cells(L - i, 8), mais j'ai trouvé une solution.

Pour information :

Sub PNR_Parents()

Dim L As Integer
Dim i As Integer

For L = 1 To 200

    If Cells(L, 6) = 0 Then
    Cells(L, 15) = 0
    End If

    If Cells(L, 6) = 1 Then
    Cells(L, 15) = 0
    End If

    If Cells(L, 6) = 2 Then
        For i = 1 To L - 1
            If Cells(L - i, 6) = 1 Then

                Cells(L - i, 8).Select
                 Selection.Copy
                 Cells(L, 15).Select
                 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
                Exit For
            End If
     Next i
    End If

       If Cells(L, 6) = 3 Then
        For i = 1 To L - 1
        If Cells(L - i, 6) = 2 Then

            Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
            Exit For
        End If
    Next i
    End If
       If Cells(L, 6) = 4 Then
        For i = 1 To L - 1
        If Cells(L - i, 6) = 3 Then

            Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
            Exit For
        End If
    Next i
    End If
       If Cells(L, 6) = 5 Then
        For i = 1 To L - 1
        If Cells(L - i, 6) = 4 Then

            Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
            Exit For
        End If
    Next i
    End If
       If Cells(L, 6) = 6 Then
        For i = 1 To L - 1
        If Cells(L - i, 6) = 5 Then

            Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
            Exit For
        End If
    Next i
    End If
       If Cells(L, 6) = 7 Then
        For i = 1 To L - 1
        If Cells(L - i, 6) = 6 Then

            Cells(L - i, 8).Select
             Selection.Copy
             Cells(L, 15).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
            Exit For
        End If
    Next i
    End If
Next L

End Sub

Bonjour Jujuchon,

Ton long code VBA peut être ainsi réduit :

Option Explicit

Sub PNR_Parents()
  Dim L As Integer, k As Byte, i As Integer
  Application.ScreenUpdating = False
  For L = 1 To 200
    k = Cells(L, 6)
    Select Case k
      Case 0, 1: Cells(L, 15) = 0
      Case Is >1:
        For i = 1 To L - 1
          If Cells(L - i, 6) = k - 1 Then
            Cells(L, 15) = Cells(L - i, 8): Exit For
          End If
        Next i
    End Select
  Next L
End Sub

Attention

Remarque bien ceci : « Case Is >1: » est pour tes cas 2 à 7.

Si tu as (ou auras) un cas 8 pour lequel ça fait le même travail,

tu pourras laisser tel que car « Case Is >1: » sera pour 2 à 8.

Si tu as (ou auras) un cas 8 pour lequel ça fait le même travail

que pour les cas 0 et 1, tu peux ajouter « , 8 » ainsi :

« Case 0, 1, 8: Cells(L, 15) = 0 »

Si tu as (ou auras) un cas 8 pour lequel ça doit faire un travail différent

des cas précédents, tu devras remplacer « Case Is >1: » par « Case 2 To 7: »

et ajouter un « Case 8: » (ou éventuellement un « Case Else: »).

Si tu as (ou auras) des cas > 8 (9 ou autres), le raisonnement est le même

que pour 8 : à adapter en conséquence de la même façon.

Je te laisse tester et vérifier mon code VBA.

Merci de me donner ton avis.

Cordialement