j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
> alors, en testant, ça a l'air de marché, sauf que ça plante....
alors, en testant, ça a l'air de marché, sauf que ça plante à partir de la
colonne AA.
c'est ptèt les 2 lettres qu'il aime pas.
Merci.
YANN
"Sunburn" a écrit :j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <>
""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre >> "B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne &
Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
> alors, en testant, ça a l'air de marché, sauf que ça plante....
alors, en testant, ça a l'air de marché, sauf que ça plante à partir de la
colonne AA.
c'est ptèt les 2 lettres qu'il aime pas.
Merci.
YANN
"Sunburn" a écrit :
j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <>
""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre >> "B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne &
Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
> alors, en testant, ça a l'air de marché, sauf que ça plante....
alors, en testant, ça a l'air de marché, sauf que ça plante à partir de la
colonne AA.
c'est ptèt les 2 lettres qu'il aime pas.
Merci.
YANN
"Sunburn" a écrit :j'ai modifié comme ça, je sais pas si c'est OK :
----
Private Sub CommandButton1_Click()
Tableau_80_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <>
""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre >> "B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne &
Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
End If
Application.CutCopyMode = False
End Sub
-----
> alors, en testant, ça a l'air de marché, sauf que ça plante....
Ca alors , l'air mais pas la chanson !
;o)))
--
Salutations
JJ
> alors, en testant, ça a l'air de marché, sauf que ça plante....
Ca alors , l'air mais pas la chanson !
;o)))
--
Salutations
JJ
> alors, en testant, ça a l'air de marché, sauf que ça plante....
Ca alors , l'air mais pas la chanson !
;o)))
--
Salutations
JJ
Rebonjour à toi
Pour ta première anomalie concernant le seuil fatidique de 19 lignes
Une petite coquille dans mon code
Je l'ai corrigé ainsi :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
If IsNumeric(Mid(Split(Range(Colonne & Target.Row + 2).Formula, ":")(1), 2,
1)) Then
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Else
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 2) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3)) - 1) + 1 & ")"
End If
Next
End If
Application.CutCopyMode = False
End Sub
Pour le nettoyage il faut retirer du code la ligne :
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
Que j'avais mise dans ton précédent classeur pour corriger les formules de
la colonne R qui ne s'adaptaient pas
Sur ce lien ton document adapté ainsi :
http://www.cijoint.fr/cjlink.php?file=cj200812/cijUiH7GF7.xls
Fais des essais et dis moi !!!!
Rebonjour à toi
Pour ta première anomalie concernant le seuil fatidique de 19 lignes
Une petite coquille dans mon code
Je l'ai corrigé ainsi :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
If IsNumeric(Mid(Split(Range(Colonne & Target.Row + 2).Formula, ":")(1), 2,
1)) Then
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Else
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 2) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3)) - 1) + 1 & ")"
End If
Next
End If
Application.CutCopyMode = False
End Sub
Pour le nettoyage il faut retirer du code la ligne :
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
Que j'avais mise dans ton précédent classeur pour corriger les formules de
la colonne R qui ne s'adaptaient pas
Sur ce lien ton document adapté ainsi :
http://www.cijoint.fr/cjlink.php?file=cj200812/cijUiH7GF7.xls
Fais des essais et dis moi !!!!
Rebonjour à toi
Pour ta première anomalie concernant le seuil fatidique de 19 lignes
Une petite coquille dans mon code
Je l'ai corrigé ainsi :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.ColorIndex = 36 And Target.Offset(1,
0).Interior.ColorIndex = xlNone And Cells(Target.Row, Target.Column) <> ""
Then
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre =
"B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/AA/AB/AC/AD/AE/AF/AG/AH"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
If IsNumeric(Mid(Split(Range(Colonne & Target.Row + 2).Formula, ":")(1), 2,
1)) Then
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Else
Range(Colonne & Target.Row + 2).Formula = Split(Range(Colonne & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 1, 2) & Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3, Len(Mid(Split(Range(Colonne & Target.Row +
2).Formula, ":")(1), 3)) - 1) + 1 & ")"
End If
Next
End If
Application.CutCopyMode = False
End Sub
Pour le nettoyage il faut retirer du code la ligne :
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
Que j'avais mise dans ton précédent classeur pour corriger les formules de
la colonne R qui ne s'adaptaient pas
Sur ce lien ton document adapté ainsi :
http://www.cijoint.fr/cjlink.php?file=cj200812/cijUiH7GF7.xls
Fais des essais et dis moi !!!!