VBA insertion ligne

Hello tout le monde,

je suis bloquée et j'aimerais comprendre pourquoi

je m'explique :

j'ai un tableau (avec 14000 lignes) et j'aimerais qu'à chaque fois que la valeur de la cellule B est différente de la cellule juste au dessus et bien que ça m'insère une ligne (pour avoir une séparation)

J'ai fait le code suivant mais il ne fonctionne pas, pouvez-vous m'éclairer ?

Sub sauter_une_ligne()

Dim x As Variant
Dim y As Variant
Dim WR As Worksheet

Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")

With WR
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
If .Cells(x, 2).Value <> .Cells.Offset(-1, 0).Value Then
Rows.Insert Shift:=xlDown
End If
Next x
End With

End Sub

Je sais que la fin est pourrie

Merci !

Clem

Salut Cleiiim,

voici du pain sur la planche car je n'ai pas repris ton code exactement : ça te fera un devoir!

Info : ce genre de boucle doit s'exécuter de bas en haut!

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
If WorksheetFunction.CountBlank(Range("B2:B" & iRowB)) > 0 Then
    Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    iRowB = Range("B" & Rows.Count).End(xlUp).Row
End If
For x = iRowB To 2 Step -1
    If Cells(x, 2).Value <> Cells(x - 1, 2).Value Then
        Rows(x).Insert Shift:=xlDown
    End If
Next
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour

Essayez comme ceci

Sub sauter_une_ligne()
Dim x As Long
Dim WR As Worksheet

Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")

With WR
 For x = .Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
        If .Cells(x, 2).Value <> .Cells(x, 2).Offset(-1, 0).Value Then
            Rows(x).Insert Shift:=xlDown
        End If
Next x
End With
End Sub

Crdlt

Merci pour votre réponse à tous les 2

Dan, je ne sais pas pourquoi mais ton code tourne sans que rien ne se passe ...

Sinon du coup j'ai réussi à faire ce code :

Sub sauter_une_ligne()

Dim x As Variant
Dim y As Variant
Dim WR As Worksheet

Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")

With WR
For x = 3 To Range("A" & Rows.Count).End(xlUp).Row
If .Cells(x, 2).Value <> .Cells(x - 1, 2).Value Then
Rows(x ).Insert Shift:=xlDown
End If
Next x
End With

End Sub

En fait c'était ce bout de code qui me plantait avant : If .Cells(x, 2).Value <> .Cells.Offset(-1, 0).Value Then.

Mais sinon le problème avec mon code c'est qu'il insère bien une ligne, sauf qu'après forcément la ligne juste au-dessus sera toujours différente de celle de dessous vu qu'il a inséré une ligne.

Du coup il m’insère des lignes sans fin ^^

Je pense qu'il faudrait que je mette une condition pour que lorsqu'il y a une ligne "vide" entre les 2 il ne la prenne pas en compte mais je ne suis pas encore assez calée pour faire ça.

Curulis57, c'est effectivement pour quoi ce genre de boucle doit s'effectuer de bas en haut, bien vu ! je m'en suis rendu compte quand mon code m'a mis 15 000 lignes

Ton code marche nickel,

je ne comprends pas trop cette partie par contre :

If WorksheetFunction.CountBlank(Range("B2:B" & iRowB)) > 0 Then
    Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Peux-tu m'expliquer ?

Merci,

Cleiiim

Salut Cleiiim,

Salut Dan,

Ce bout de code calcule si il y a des lignes vides et les supprime ce qui facilite le calcul.

Cela dit, relire l'ensemble des 14000 lignes de ton fichier doit sûrement prendre du temps : il faudrait optimiser le processus.

je regarde ça dès que je peux... si tu en as besoin, bien sûr!

A+

RE,

Currulis, en premier désolé mais je n'avais vu que vous aviez fourni un code juste avant que je ne poste...

Cleliim,

Dan, je ne sais pas pourquoi mais ton code tourne sans que rien ne se passe ...

Dans mon code remplacez la lettre B par A.

Je ne comprends pas pourquoi vous bouclez sur la colonne A et vérifiez sur la colonne B, d'où le changement de colonne (B à la place de A) que j'ai mis dans le code.

En pièce jointe un fichier pour test avec le code que j'avais proposé, donc sur colonne B.

Crdlt

Re,

Dan, le code fonctionne, je ne sais pas ce que j'ai fait hier ...

Par contre je ne comprends pas quelle partie du code dit qu'il faut commencer à la fin ?

curulis57, effectivement le code a tourné pendant 3 minutes. Maintenant c'est fait mais je serai curieuse de savoir comment optimiser le processus si tu as un peu de temps

Merci à vous 2

Cleiiim

Re

Par contre je ne comprends pas quelle partie du code dit qu'il faut commencer à la fin ?

C'est au niveau de la 1ere ligne de la boucle --> For x = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1

Au fait n'oubliez pas de mettre les points devant Range et devant Rows.count.

Si vous exécutiez votre code depuis une autre feuille que WR vous pourriez obtenir tout à fait autre chose que ce qui est souhaité

Crdlt

C'est noté

Merci

Cleiiim