Rajouter des lignes

[bobjazz]

Bonjour le Forum

Est ce qu'il est possible de rajouter 2 lignes à l'aide d'une macro chaque fois que je trouve "CC" dans la colonne A.
dans mon fichier j'ai 6000 lignes

Merci d'avance

Bobjazz

 

[phlaurent55]

Re : Rajouter des lignes

Bonjour Bobjazz,

voir fichier joint
il est nécessaire d'activer les macros

à+
Philippe

 

[fhoest]

Re : Rajouter des lignes

Bonjour,
voici une macro

Sub ajout_ligne()
Dim C As Range
For Each C In Range("a1:a6000")
If C Like "CC" Then Rows(C.Row + 1).Insert
Next
End Sub

A+

 

[bobjazz]

Re : Rajouter des lignes

Re Bonjour

Merci à phlaurent55 et fhoest

Super

Bobjazz

 

[bobjazz]

Re : Rajouter des lignes

Re Bonjour

Est-il possible de rajouter "CC" dans les 2 cases que l'on rajoute.

Merci

Bobjazz

 

[phlaurent55]

Re : Rajouter des lignes

Re,

remplace le code du fichier au post #2 par ceci:

Sub Bouton1_Clic()
Application.ScreenUpdating = False
Dim derligne
derligne = Range("A65535").End(xlUp).Row
For i = derligne To 2 Step -1
If Cells(i - 1, 1).Value = "CC" Then
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
End If
Next i
[A1].Select
Application.ScreenUpdating = True
End Sub

à+
Philippe

 

[bobjazz]

Re : Rajouter des lignes

Re

Super
si je comprend bien

Cells(i, 1).Value = "CC" veut dire rajouter "CC" dans la cellule

et si je veux copier la cellule qui est à côté en même temps c'est à dire, par exemple je copie la cellule B3 en B4 et B5, là cela devient compliqué pour moi
je sais faire cela, mais je ne voit pas comment l'intégrer en automatique
Range("B3").Select
Selection.Copy
Range("B4").Select
ActiveSheet.Paste

Je te remercie d'avance, après j'aurai fini mon fichier, tu m'as vraiment fait avancé dans un sens.

Bobjazz

 

[phlaurent55]

Re : Rajouter des lignes

Re,

avec ceci:

Sub Bouton1_Clic()
Application.ScreenUpdating = False
Dim derligne
derligne = Range("A65535").End(xlUp).Row
For i = derligne To 2 Step -1
If Cells(i - 1, 1).Value = "CC" Then
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Cells(i, 2).Value = Cells(i - 1, 2).Value
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Cells(i, 2).Value = Cells(i - 1, 2).Value
End If
Next i
[A1].Select
Application.ScreenUpdating = True
End Sub

à+
Philippe

 

[bobjazz]

Re : Rajouter des lignes

phlaurent55

Encore Merci

Bobjazz