insertion de ligne selon criteres

J

jb

Guest
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
 
T

Ti

Guest
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
 
J

jb

Guest
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
 
T

Ti

Guest
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
 

Discussions similaires

Réponses
3
Affichages
369

Statistiques des forums

Discussions
299 706
Messages
1 978 625
Membres
206 312
dernier inscrit
dameli70