Boucle duplication de lignes selon conditions
Bonjour à tous,
Je suis débutante en VBA et je rencontre des difficultés avec mon programme.
Je souhaiterais réaliser une boucle qui duplique ma ligne en fonction de certaines conditions.
J'ai tout d'abord écrit ce programme :
With Sheets("Import Template")
FirstRow = 2
LastRow = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row
For j = FirstRow To LastRow
'CableWaySegmentItemTag
BranName = Cells(j, 3).Value
'Segregation Level
SegregationLevel = Mid(BranName, 10, 1)
Cells(j, 1).Select
Select Case SegregationLevel
'If Segregation Level is N
Case "N"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is P
Case "P"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is Z
Case "Z"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
End Select
Next j
End WithCependant le problème de ce programme est que dans la boucle For, le paramètre final à atteindre (LastRow) n'est pas incrémenté. La boucle garde seulement la valeur initiale de LastRow.
Donc après duplication des lignes, la valeur de LastRow est modifiée mais la boucle For ne le prend pas en compte.
J'ai donc essayé de remplacer le "For" par un "While...Wend" :
With Sheets("Import Template")
j = 2
LastRow = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row
While j <= LastRow
'CableWaySegmentItemTag
BranName = Cells(j, 3).Value
'Segregation Level
SegregationLevel = Mid(BranName, 10, 1)
Cells(j, 1).Select
Select Case SegregationLevel
'If Segregation Level is N
Case "N"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is P
Case "P"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is Z
Case "Z"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
End Select
Wend
End WithMais lorsque je lance le programme, l'Excel plante et semble rentrer dans une boucle infinie.
Pourriez-vous m'aider ?
Vous remerciant par avance
Bonjour Ana 9
Essaie comme cela
With Sheets("Import Template")
j = 2
LastRow = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row
While j <= LastRow
'CableWaySegmentItemTag
BranName = Cells(j, 3).Value
'Segregation Level
SegregationLevel = Mid(BranName, 10, 1)
Cells(j, 1).Select
Select Case SegregationLevel
'If Segregation Level is N
Case "N"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is P
Case "P"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
'If SegregationLevel is Z
Case "Z"
'Line duplication
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow
LastRow = LastRow + 1
j = j + 1
End Select
j = j + 1
Wend
End WithEn fait quand tu recopies une ligne dans ton code , tu ne fais pas évoluer j comme il faut, donc tu recopies toujours la même ligne.
Bon courage
Bonjour,
A tester.
Cdlt.
With Worksheets("Import Template")
FirstRow = 2
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lRow = lastRow To FirstRow Step -1
'CableWaySegmentItemTag
BranName = Cells(lRow, 3).Value
'Segregation Level
SegregationLevel = Mid(BranName, 10, 1)
Select Case SegregationLevel
Case "N", "P", "Z":
'Line duplication
With .Cells(lRow, 1)
.Offset(1).EntireRow.Insert ' xlShiftDown
.EntireRow.Copy .Offset(1).EntireRow
End With
End Select
Next lRow
End WithBonjour Ana 9
Essaie comme cela
With Sheets("Import Template") j = 2 LastRow = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row While j <= LastRow 'CableWaySegmentItemTag BranName = Cells(j, 3).Value 'Segregation Level SegregationLevel = Mid(BranName, 10, 1) Cells(j, 1).Select Select Case SegregationLevel 'If Segregation Level is N Case "N" 'Line duplication ActiveCell.Offset(1).EntireRow.Insert ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow LastRow = LastRow + 1 j = j + 1 'If SegregationLevel is P Case "P" 'Line duplication ActiveCell.Offset(1).EntireRow.Insert ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow LastRow = LastRow + 1 j = j + 1 'If SegregationLevel is Z Case "Z" 'Line duplication ActiveCell.Offset(1).EntireRow.Insert ActiveCell.EntireRow.Copy ActiveCell.Offset(1).EntireRow LastRow = LastRow + 1 j = j + 1 End Select j = j + 1 Wend End WithEn fait quand tu recopies une ligne dans ton code , tu ne fais pas évoluer j comme il faut, donc tu recopies toujours la même ligne.
Bon courage
Bonjour Patty5046,
Cela marche parfaitement, merci beaucoup !
Bonjour Ana9, bonjour Jean-Eric
Contente que ton problème soit résolu, mais je n'avais fait que corriger ton erreur. La solution de Jean-Eric est plus "propre" et marche aussi très bien..L'as-tu testée ?
Bonne journée à tous