VBA : IF and IF

Fermé
mikegolden3 Messages postés 4 Date d'inscription lundi 9 avril 2007 Statut Membre Dernière intervention 29 juillet 2011 - 29 juil. 2011 à 01:42
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 29 juil. 2011 à 09:24
Bonjour,

Je suis occupé dans un code VBA et je tourne un peu en rond sur un IF :

Le code consiste a effectuer une rupture (en ajoutant une ligne) des que la valeur entre la ligne 1 et la valeur dans la ligne 1 + 1 est différente.

Avec un seul if, le code tourne en rond puisque le IF retombe sur la ligne qu'il vient de creer et donc crée des lignes apres la premiere rupture.

Je veux donc integrer un deuxieme IF pour qu'il ignore les lignes à "Blank" mais j'ai du mal sur la facon de gerer les deux IF.

Si vous pouviez m'eclairer de vos lumieres ?

Merci d'avance

Voici mon code :
Sub Rupt()

WBName = Application.ActiveWorkbook.Name 'Excel Name
FromWS = "DB CLEAN" 'Source Name Sheet
ToWS = "TO IMPORT ALL" 'Target Name Sheet
iLigneFrom = 3
iLigneTo = 100

For iLigne = iLigneFrom To iLigneTo 'Lines in the source sheet
If Workbooks(WBName).Worksheets(ToWS).Cells(iLigne, 18).Value <> Workbooks(WBName).Worksheets(ToWS).Cells(iLigne - 1, 18).Value Then
ElseIf Workbooks(WBName).Worksheets(ToWS).Cells(iLigne, 18).Value <> "" Then


Workbooks(WBName).Worksheets(ToWS).Rows(iLigne).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End If
Next

End Sub

1 réponse

melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
29 juil. 2011 à 09:24
Bonjour,

essaie ca :

Sub Rupt()

WBName = Application.ActiveWorkbook.Name 'Excel Name
FromWS = "DB CLEAN" 'Source Name Sheet
ToWS = "TO IMPORT ALL" 'Target Name Sheet
iLigneFrom = 3
iLigneTo = 100

For iLigne = iLigneFrom To iLigneTo 'Lines in the source sheet


If Workbooks(WBName).Worksheets(ToWS).Cells(iLigne, 18).Value <> Workbooks(WBName).Worksheets(ToWS).Cells(iLigne - 1, 18).Value and If Workbooks(WBName).Worksheets(ToWS).Cells(iLigne, 18).Value <> "" and If Workbooks(WBName).Worksheets(ToWS).Cells(iLigne-1, 18).Value <> "" then

Workbooks(WBName).Worksheets(ToWS).Rows(iLigne).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

end if
Next

End Sub
0