insertion cellule

slt à tous,
j'ai un petit pb d'insertion.
Voilà je voudrais avoir un code vba qui me permette d'insérer une cellule vers le haut quand je rencontre un certain texte.

Pour le moment j'ai inséré vers le bas avec ce code
:
Sub insert()
Dim Cel As Range, sr As String
Columns("A:o").Select
For Each Cel In Range("e1:e" & Range("e65536").End(xlDown).Row)
If Cel.Value = "" Then GoTo suite
If Cel.Value = "XXX" Then
Cel.Offset(1, -4).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, -3).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, -2).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, -1).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 0).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 1).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 2).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 3).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 4).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 5).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 6).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 7).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 8).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 9).Select
Cel.Offset(1, 10).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 11).Select
Selection.insert Shift:=xlDown

Selection.insert Shift:=xlDown
Cel.Offset(1, 12).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 13).Select
Selection.insert Shift:=xlDown
End If

suite:
Next Cel
End Sub


Mai quand je veux fait Selection.insert Shift:=up,
ca marche pas (ca doit pas exister...).
Donc si vous pouviez m'aider ca serait cool.

Merci à tous d'avance.

Emmanuel

essaye avec : .EntireRaw.Insert



pour le reste, ce serait moins lourd avec un boucle
"Cel.Offset(1, -4).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, -3).Select
.......
Selection.insert Shift:=xlDown
Cel.Offset(1, 9).Select
Selection.insert Shift:=xlDown
Cel.Offset(1, 10).Select"

essaye avec quelque chose comme ça :

for i= -4 to 10
   Cel.Offset(1, i).Select
   Selection.EntireRaw.Insert
next i

Cette procédure insert une ligne(cellule) au dessus de la cellule contenant "xxx" entre les cellules ("A1:O100")

Sub Insert ()
Dim strx As String
strx = "xxx"
Dim r, c, d
d = strx
Application.ScreenUpdating = False
For r = 1 To 100
    For c = 1 To 15
    If Cells(r, c).Value = d Then
    Cells(r, c).Select
  End If
 Next c
Next r
Selection.EntireRow.Insert
Application.ScreenUpdating = True
End Sub

jpleroisse

Merci à tous les 2. Ca marche ;-)

Emmanuel

En fait, .... ça marche pas tout à fait.
Je veux insérer une cellule entre A et O et pas une ligne entière.
Donc j'ai changé ton code en :
 Sub insertligneACR()

Dim strx As String
strx = "XXX"
Dim i, c, d
d = strx

For i = 50 To 75
    For c = 3 To 3
    If Cells(i, c).Value = d Then
    Range(Cells(i, 1), Cells(i, 15)).Select
    Selection.Insert Shift:=xlDown

    End If
 Next c
Next i
End Sub


Ca insère bien entre A et O , mais ca insère sur 25 lignes!
Et c'est du au i= 50 to 75 (si je met i = 1 to 100, ca insère  sur 100 lignes...).
Donc si tu vois comment faire en sorte d'insérer une seule cellule dans les colonnes A à O, ca m'arrangerais.

@+
Emmanuel

En fait ca insère^pas 25 lignes quand je met i de 50 à 75, plus précisemment, ca insère jusqu'à ce que j'arrive à 75.
I.e. je rencontre une fois XXX à la ligne 70, et il la macro m'insère 5 lignes, de 70 à 75.
Si i va jusqu'à 100, elle m'insère 30 lignes de 70 à 100...
Si vous comprenez...


Emmanuel

Je ne vois pas ce que je peux faire de plus , car insérer une cellule, cela n'est pas possible, quand on "insert" une cellule en réalité c'est une ligne car forcément une cellule se trouve dans une ligne.

jpleroisse

Mais pourtant si tu fais la macro:
Dim cel As Range, sr As String
Columns("A:o").Select
For Each cel In Range("B1:B" & Range("B65536").End(xlDown).Row)
If cel.Value = "" Then GoTo suite
If cel.Value <> cel.Offset(1, 0).Value Then
sr = cel.Offset(1, 2).Value
cel.Offset(1, 1).Select
cel.Offset(1, -1).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 0).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 1).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 2).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 3).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 4).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 5).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 6).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 7).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 8).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 9).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 10).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 11).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 12).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 13).Select
Selection.Insert Shift:=xlDown
cel.Offset(1, 3).Value = sr
Selection.Font.Bold = True
End If

suite:
Next cel
End Sub


(je crois mm que c'est toi qui me l'avais donnée)
Et bien tu insère une cellule en dessous de la case que tu veux pour les collenes A à O.
Là tu n'insère pas une ligne (pour moi une ligne c'est de la colonne 1 à la colonne 65555...).


Emmanuel