Insérer ligne quand Lig <>lig+1 vb
Résolu
pgillou
Messages postés
53
Statut
Membre
-
pgillou Messages postés 53 Statut Membre -
pgillou Messages postés 53 Statut Membre -
Bonjour à tous,
Nouveau petit problème je cherche à parcourir une colonne est à insérer une ligne entre deux cellule n'ayant pas la même valeur:
Voici mon code mais qui ne fonctionne pas correctement
Sub Inserligne()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Sheets("Feuil1").Activate 'feuille de destination
NumLig = 0
Col = "B" ' colonne feuille source à parcourir
NumLig = 0
With Sheets("Feuil1") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value <> .Cells(Lig + 1, Col).Value Then
NumLig = NumLig + 1
Cells(Lig, Col).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End With
End Sub
Merci de votre aide!
Nouveau petit problème je cherche à parcourir une colonne est à insérer une ligne entre deux cellule n'ayant pas la même valeur:
Voici mon code mais qui ne fonctionne pas correctement
Sub Inserligne()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Sheets("Feuil1").Activate 'feuille de destination
NumLig = 0
Col = "B" ' colonne feuille source à parcourir
NumLig = 0
With Sheets("Feuil1") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value <> .Cells(Lig + 1, Col).Value Then
NumLig = NumLig + 1
Cells(Lig, Col).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End With
End Sub
Merci de votre aide!
4 réponses
-
Bonjour,
J'ai pas bien compris là...
Tu parle d'insérer une ligne..., d'une autre feuille,... et tu insére des cellules ??
Un peu plus clair Svp
A+ -
Bonsoir Lermitte222,
Je formule a autrement j'ai énormement de lignes sur mon tableau et je souhaiterais insérer des lignes vierges entre les lignes donc les cellules de la colonne c n'ont pas la même valeur.
Exemple:
Colonne A Colonne B Colonne C
test info comment
test info comment
Test info marche web
Résultat:
test info comment
test info comment
Test info marche web
Merci de ton aide! -
Sub InsertionLigne() Dim Lig As Long For Lig = Range("B65536").End(xlUp).Row To 2 Step -1 If Cells(Lig, "B") = Cells(Lig - 1, "B") Then Rows(Lig + 1).Insert Lig = Lig - 1 End If Next Lig End Sub
A mettre dans le module de "Feuil1"
Tu dis
A+
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius) -
Je te remercie c'est pile poil ce qui me fallait!
Bonne après midi
