insertion de ligne selon criteres

[jb]

bonjour


je tourne en rond alors j'appelle à l'aide ;

Mon probleme est le suivant

j'ai une feuille avec x lignes et je voudrais inserer une ligne selon un critere

bien precis dans mon cas toutes les 3 ou 2 lignes si ma cellule en colonne

b = "C1" je dois inserer une ligne

j' espere avoir ete clair

merci de votre réponse



JB

 

[Ti]

Si j'ai bien compris ton problème, je suppose que tu veux en fait comparer le contenu des cellules de la colonne B au contenu de la cellule "C1" et dans ce cas j'insère une ligne au dessus
Je considère ici que tes données à comparer commencent à la cellule B1, au besoin il faudra changer cette adresse.
Tiens-moi au courant si ce n'est pas ça que tu veux

*****************

Option Explicit

Sub Insertion_Ligne()
Dim MyWs As Worksheet
Dim MyRange As Range, Cel As Range
Dim Reference As Variant
Dim FirstAd As String

Set MyWs = ThisWorkbook.ActiveSheet
Set MyRange = MyWs.Range("B1", Range("B1").End(xlDown))
Reference = MyWs.Range("C1").Value

With MyRange
Set Cel = .Find(Reference, LookIn:=xlValues)
If Not Cel Is Nothing Then
FirstAd = Cel.Offset(1, 0).Address
Do
Cel.EntireRow.Insert
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAd
End If
End With
End Sub

 

[jb]

Merci Ti pour ta reponse



En fait j'ai un fichier excel avec 3000 lignes une recup d'un fichier compta


et je dois inserer une ligne si je trouve en colonne b la valeur "C1"

et non comparer la colonne b avec la celule C1

je savais que je n'avais pas ete clair


a+

jb

 

[Ti]

Pas de problème, dans le code ci-dessus, tu remplaces la ligne

Reference = MyWs.Range("C1").Value

par

Reference = "C1"

et ça devrait jouer parfaitement
voici la nouvelle procédure :

Option Explicit

Sub Insertion_Ligne()
Dim MyWs As Worksheet
Dim MyRange As Range, Cel As Range
Dim Reference As Variant
Dim FirstAd As String

Set MyWs = ThisWorkbook.ActiveSheet
Set MyRange = MyWs.Range("B1", Range("B1").End(xlDown))
Reference = "C1"

With MyRange
Application.ScreenUpdating = False
Set Cel = .Find(Reference, LookIn:=xlValues)
If Not Cel Is Nothing Then
FirstAd = Cel.Offset(1, 0).Address
Do
Cel.EntireRow.Insert
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAd
End If
End With

Application.ScreenUpdating = True
End Sub