pour FFO (même si ça se fait pas dans un en-tête, désolé)
15 réponses
Sunburn
Bonjour,
tout d'abord, les autres peuvent participer.... :°), ce sujet n'est pas fermé.
FFO m'avais fais une macro pour rajouter une ligne à la fin de tableaux, en
fonction de ma précédente demande. De plus, il y a un code pour réinitialiser
ces tableaux.
Est-il possible d'adapter les codes afin de l'appliquer à ce tableau
ci-joint ?
http://cjoint.com/?mdqMqAfCjA
Merci.
yann
---
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Offset(1, 0).Interior.ColorIndex = xlNone And
Target.Interior.ColorIndex = 36 And Cells(Target.Row, Target.Column) <> ""
Then
Formule1 = Range("D" & Target.Row + 1).Formula
Formule2 = Range("E" & Target.Row + 1).Formula
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
Range("D" & Target.Row + 2).Formula = Split(Range("D" & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("D" & Target.Row + 2).Formula,
":")(1), 1, 1) & Mid(Split(Range("D" & Target.Row + 2).Formula, ":")(1), 2,
Len(Mid(Split(Range("D" & Target.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Range("E" & Target.Row + 2).Formula = Split(Range("E" & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("E" & Target.Row + 2).Formula,
":")(1), 1, 1) & Mid(Split(Range("E" & Target.Row + 2).Formula, ":")(1), 2,
Len(Mid(Split(Range("E" & Target.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
End If
Application.CutCopyMode = False
End Sub
------
'nettoyage des feuilles à tableaux 60.21 et 90.31
Sub Nettoyage()
For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "90_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("D65535").End(xlUp).Row
If Range("A9").Offset(i, 0).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 0).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 3 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
End Sub
------
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des colonnes qui en possèdent pour les lignes ajoutées Sur ma proposition dont tu fais mention seules 2 colonnes devaient être mises à jour Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser Dur dur !!! J'ai pour celà utilisé un boucle pour alléger le code De plus dans ma proposition ci-dessous on faisait appel à un évennement Or dans ton fichier on utilise l'action d'un bouton J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la couleur jaune des cellules colonne A pour fonctionner correctement Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas modifier ce format pour un fonctionnement correct Or dans ton fichier disparu la couleur colonne A Bandit !!!! Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du tableau actives le bouton "Ajouter une ligne en dessous de la ligne active" Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click() If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0, 1).Interior.ColorIndex = 36 Then If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown ActiveCell.Offset(1, 0).ClearContents ActiveCell.Offset(-1, 0).EntireRow.Copy ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T" For i = 0 To UBound(Split(Lettre, "/")) Colonne = Split(Lettre, "/")(i) Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")" Next Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8" Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row + 2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1 End If End If End Sub
Nettoyage:
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 3 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Next
Fais des essais et dis moi !!!
Salut à toi
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des
colonnes qui en possèdent pour les lignes ajoutées
Sur ma proposition dont tu fais mention seules 2 colonnes devaient être
mises à jour
Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser
Dur dur !!!
J'ai pour celà utilisé un boucle pour alléger le code
De plus dans ma proposition ci-dessous on faisait appel à un évennement
Or dans ton fichier on utilise l'action d'un bouton
J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la
couleur jaune des cellules colonne A pour fonctionner correctement
Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas
modifier ce format pour un fonctionnement correct
Or dans ton fichier disparu la couleur colonne A
Bandit !!!!
Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B
Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi
Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du
tableau actives le bouton "Ajouter une ligne en dessous de la ligne active"
Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click()
If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0,
1).Interior.ColorIndex = 36 Then
If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).ClearContents
ActiveCell.Offset(-1, 0).EntireRow.Copy
ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8"
Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row +
2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1
End If
End If
End Sub
Nettoyage:
For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 3 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des colonnes qui en possèdent pour les lignes ajoutées Sur ma proposition dont tu fais mention seules 2 colonnes devaient être mises à jour Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser Dur dur !!! J'ai pour celà utilisé un boucle pour alléger le code De plus dans ma proposition ci-dessous on faisait appel à un évennement Or dans ton fichier on utilise l'action d'un bouton J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la couleur jaune des cellules colonne A pour fonctionner correctement Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas modifier ce format pour un fonctionnement correct Or dans ton fichier disparu la couleur colonne A Bandit !!!! Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du tableau actives le bouton "Ajouter une ligne en dessous de la ligne active" Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click() If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0, 1).Interior.ColorIndex = 36 Then If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown ActiveCell.Offset(1, 0).ClearContents ActiveCell.Offset(-1, 0).EntireRow.Copy ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T" For i = 0 To UBound(Split(Lettre, "/")) Colonne = Split(Lettre, "/")(i) Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")" Next Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8" Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row + 2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1 End If End If End Sub
Nettoyage:
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 3 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Next
Fais des essais et dis moi !!!
Sunburn
salut FFO, bon et bien, tout d'abord je te remercie encore de te pencher sur mon probleme. par contre, j'ai oublié de te préciser, qu'en fait, le bouton, c'est ce que j'ai actuellement, et que je voulais le supprimer, donc j'ai besoin de ton aide pour automatiser cette tache, dès qu'on est sur la dernière ligne. pour les colonnes, oui je sais, 18 ça pas du etre facile. Donc un évènement au lieu du bouton m'irait à ravir. pour les couleurs, je n'y touche plus, t'inquiète .... pour le bouton "nettoyage", une précision de la page, car je voudrais et un bouton pour le faire à la mano si nécessaire, et aussi dans mon code plus complexe de suppression globale.
Précision : ce tableau est un autre tableau que les tableaux pour lesquels tu m'avais fais le travail de la macro. Je te rassure en te précisant que je les utilise, et que c'est nikel. C'est pour cela que j'ai voulu automatiser ce tableau..... Le bonheur entraine le bonheur !!!!
Merci beaucoup de ton aide.
YANN
"FFO" a écrit :
Salut à toi
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des colonnes qui en possèdent pour les lignes ajoutées Sur ma proposition dont tu fais mention seules 2 colonnes devaient être mises à jour Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser Dur dur !!! J'ai pour celà utilisé un boucle pour alléger le code De plus dans ma proposition ci-dessous on faisait appel à un évennement Or dans ton fichier on utilise l'action d'un bouton J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la couleur jaune des cellules colonne A pour fonctionner correctement Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas modifier ce format pour un fonctionnement correct Or dans ton fichier disparu la couleur colonne A Bandit !!!! Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du tableau actives le bouton "Ajouter une ligne en dessous de la ligne active" Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click() If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0, 1).Interior.ColorIndex = 36 Then If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown ActiveCell.Offset(1, 0).ClearContents ActiveCell.Offset(-1, 0).EntireRow.Copy ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T" For i = 0 To UBound(Split(Lettre, "/")) Colonne = Split(Lettre, "/")(i) Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")" Next Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8" Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row + 2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1 End If End If End Sub
Nettoyage:
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 3 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Next
Fais des essais et dis moi !!!
salut FFO,
bon et bien, tout d'abord je te remercie encore de te pencher sur mon
probleme.
par contre, j'ai oublié de te préciser, qu'en fait, le bouton, c'est ce que
j'ai actuellement, et que je voulais le supprimer, donc j'ai besoin de ton
aide pour automatiser cette tache, dès qu'on est sur la dernière ligne.
pour les colonnes, oui je sais, 18 ça pas du etre facile.
Donc un évènement au lieu du bouton m'irait à ravir.
pour les couleurs, je n'y touche plus, t'inquiète ....
pour le bouton "nettoyage", une précision de la page, car je voudrais et un
bouton pour le faire à la mano si nécessaire, et aussi dans mon code plus
complexe de suppression globale.
Précision :
ce tableau est un autre tableau que les tableaux pour lesquels tu m'avais
fais le travail de la macro. Je te rassure en te précisant que je les
utilise, et que c'est nikel. C'est pour cela que j'ai voulu automatiser ce
tableau..... Le bonheur entraine le bonheur !!!!
Merci beaucoup de ton aide.
YANN
"FFO" a écrit :
Salut à toi
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des
colonnes qui en possèdent pour les lignes ajoutées
Sur ma proposition dont tu fais mention seules 2 colonnes devaient être
mises à jour
Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser
Dur dur !!!
J'ai pour celà utilisé un boucle pour alléger le code
De plus dans ma proposition ci-dessous on faisait appel à un évennement
Or dans ton fichier on utilise l'action d'un bouton
J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la
couleur jaune des cellules colonne A pour fonctionner correctement
Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas
modifier ce format pour un fonctionnement correct
Or dans ton fichier disparu la couleur colonne A
Bandit !!!!
Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B
Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi
Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du
tableau actives le bouton "Ajouter une ligne en dessous de la ligne active"
Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click()
If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0,
1).Interior.ColorIndex = 36 Then
If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).ClearContents
ActiveCell.Offset(-1, 0).EntireRow.Copy
ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats
Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T"
For i = 0 To UBound(Split(Lettre, "/"))
Colonne = Split(Lettre, "/")(i)
Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne &
ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Next
Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row +
2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8"
Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row +
2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1
End If
End If
End Sub
Nettoyage:
For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 3 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
salut FFO, bon et bien, tout d'abord je te remercie encore de te pencher sur mon probleme. par contre, j'ai oublié de te préciser, qu'en fait, le bouton, c'est ce que j'ai actuellement, et que je voulais le supprimer, donc j'ai besoin de ton aide pour automatiser cette tache, dès qu'on est sur la dernière ligne. pour les colonnes, oui je sais, 18 ça pas du etre facile. Donc un évènement au lieu du bouton m'irait à ravir. pour les couleurs, je n'y touche plus, t'inquiète .... pour le bouton "nettoyage", une précision de la page, car je voudrais et un bouton pour le faire à la mano si nécessaire, et aussi dans mon code plus complexe de suppression globale.
Précision : ce tableau est un autre tableau que les tableaux pour lesquels tu m'avais fais le travail de la macro. Je te rassure en te précisant que je les utilise, et que c'est nikel. C'est pour cela que j'ai voulu automatiser ce tableau..... Le bonheur entraine le bonheur !!!!
Merci beaucoup de ton aide.
YANN
"FFO" a écrit :
Salut à toi
Je suppose que l'ajout des lignes doit mettre à jour toutes les formules des colonnes qui en possèdent pour les lignes ajoutées Sur ma proposition dont tu fais mention seules 2 colonnes devaient être mises à jour Dans ton fichier joint la bagatelle de 18 colonnes sont à réactualiser Dur dur !!! J'ai pour celà utilisé un boucle pour alléger le code De plus dans ma proposition ci-dessous on faisait appel à un évennement Or dans ton fichier on utilise l'action d'un bouton J'ai du en conséquence adapter le code
Enfin la macro nettoyage dans ma proposition ci-dessous se base sur la couleur jaune des cellules colonne A pour fonctionner correctement Je t'en avais parlé dans le fil correspondant et qu'il ne falait pas modifier ce format pour un fonctionnement correct Or dans ton fichier disparu la couleur colonne A Bandit !!!! Je l'ai donc adapté pour s'appuyer sur la couleur des cellules colonne B Mais surtout n'y touches plus ou adieu les bénéfices de la macro
Sur ce lien ton fichier adapté ainsi Pour l'ajout des lignes aprés avoir sélectionné la dernière ligne jaune du tableau actives le bouton "Ajouter une ligne en dessous de la ligne active" Pour le Nettoyage utilise la macro "Nettoyage"
Private Sub CommandButton1_Click() If ActiveCell.Interior.ColorIndex = 36 Or ActiveCell.Offset(0, 1).Interior.ColorIndex = 36 Then If ActiveCell.Offset(1, 1).Interior.ColorIndex = xlNone Then ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown ActiveCell.Offset(1, 0).ClearContents ActiveCell.Offset(-1, 0).EntireRow.Copy ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormats Lettre = "B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/T" For i = 0 To UBound(Split(Lettre, "/")) Colonne = Split(Lettre, "/")(i) Range(Colonne & ActiveCell.Row + 2).Formula = Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range(Colonne & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")" Next Range("S" & ActiveCell.Row + 2).Formula = Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(0) & ":" & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 1, 1) & Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2, Len(Mid(Split(Range("S" & ActiveCell.Row + 2).Formula, ":")(1), 2)) - 4) + 1 & ")+S8" Range("R" & ActiveCell.Row + 2).Formula = Mid(Range("R" & ActiveCell.Row + 2).Formula, 1, 2) & Mid(Range("R" & ActiveCell.Row + 2).Formula, 3) + 1 End If End If End Sub
Nettoyage:
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 3 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Next
Fais des essais et dis moi !!!
FFO
Rebonjour à toi Cà sera une caisse de champagne pour ton oubli !!!!! Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire Voilà ton fichier :
Rebonjour à toi
Cà sera une caisse de champagne pour ton oubli !!!!!
Ci-joint ton fichier corrigé avec l'option évennement
Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout
seul
Fais moi signe dans les cas contraire
Voilà ton fichier :
Rebonjour à toi Cà sera une caisse de champagne pour ton oubli !!!!! Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire Voilà ton fichier :
rebonjour,..... oui, je sais que ma tête me perdra..... Mais bon, j'écris juste pour te demander de mettre le bon fichier en lien s'il te plait, car là, c'est mon fichier d'origine à moi ...... :)))) Merci beaucoup. YANN
"FFO" a écrit :
Rebonjour à toi Cà sera une caisse de champagne pour ton oubli !!!!! Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire Voilà ton fichier :
rebonjour,.....
oui, je sais que ma tête me perdra.....
Mais bon, j'écris juste pour te demander de mettre le bon fichier en lien
s'il te plait, car là, c'est mon fichier d'origine à moi ......
:))))
Merci beaucoup.
YANN
"FFO" a écrit :
Rebonjour à toi
Cà sera une caisse de champagne pour ton oubli !!!!!
Ci-joint ton fichier corrigé avec l'option évennement
Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout
seul
Fais moi signe dans les cas contraire
Voilà ton fichier :
rebonjour,..... oui, je sais que ma tête me perdra..... Mais bon, j'écris juste pour te demander de mettre le bon fichier en lien s'il te plait, car là, c'est mon fichier d'origine à moi ...... :)))) Merci beaucoup. YANN
"FFO" a écrit :
Rebonjour à toi Cà sera une caisse de champagne pour ton oubli !!!!! Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire Voilà ton fichier :
Rebonjours à toi C'est bien ton fichier d'origine modifié par mes soins avec un code évennementiel Je viens de le rapatrier et vérifié
Je crois que tu as besoin de vacances n'est il pas !!!!
Donnes moi des nouvelles !!!!
Sunburn
rebonjour, ouais, je crosi que les vacances sont nécessaires : je l'ouvre, j'active les macros, je met "ne pas mettre les liasons à jour" et là, quand je descend sur la dernière ligne, et ben rien, et j'ai pas le bouton "nettoyage", j'ai toujours mon bouton et le champs de texte en rouge..... J'capte rien, dsl, mais tu as koi toi, moi j'ai ça qui m'arrive de cjoint : http://cjoint.com/?meodJNt8TB
Mereci. YANN
"FFO" a écrit :
Rebonjours à toi C'est bien ton fichier d'origine modifié par mes soins avec un code évennementiel Je viens de le rapatrier et vérifié
Je crois que tu as besoin de vacances n'est il pas !!!!
Donnes moi des nouvelles !!!!
rebonjour,
ouais, je crosi que les vacances sont nécessaires :
je l'ouvre, j'active les macros, je met "ne pas mettre les liasons à jour"
et là, quand je descend sur la dernière ligne, et ben rien, et j'ai pas le
bouton "nettoyage", j'ai toujours mon bouton et le champs de texte en
rouge.....
J'capte rien, dsl, mais tu as koi toi, moi j'ai ça qui m'arrive de cjoint :
http://cjoint.com/?meodJNt8TB
Mereci.
YANN
"FFO" a écrit :
Rebonjours à toi
C'est bien ton fichier d'origine modifié par mes soins avec un code
évennementiel
Je viens de le rapatrier et vérifié
Je crois que tu as besoin de vacances n'est il pas !!!!
rebonjour, ouais, je crosi que les vacances sont nécessaires : je l'ouvre, j'active les macros, je met "ne pas mettre les liasons à jour" et là, quand je descend sur la dernière ligne, et ben rien, et j'ai pas le bouton "nettoyage", j'ai toujours mon bouton et le champs de texte en rouge..... J'capte rien, dsl, mais tu as koi toi, moi j'ai ça qui m'arrive de cjoint : http://cjoint.com/?meodJNt8TB
Mereci. YANN
"FFO" a écrit :
Rebonjours à toi C'est bien ton fichier d'origine modifié par mes soins avec un code évennementiel Je viens de le rapatrier et vérifié
Je crois que tu as besoin de vacances n'est il pas !!!!
Donnes moi des nouvelles !!!!
FFO
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières
corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement
Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout
seul
Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est
toi qui t'en occupais
Maintenant si tu le souhaites je peux faire
Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne
As tu essayé ???
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
Sunburn
Excuses-moi !!! Milles excuses .............. :'(( je suis confu. pour tester, j'avais juste selectionné une cellule de la ligne, pas saisi dedans !!!! Quel boufon que je suis !!!! pour le bouton, pas de soucis, je vais le créer, ça je maitrise (enfin, si je retrouve toutes les facultés de mon cerveau)
Ah là là, que je suis fatigué je crois !!!
Merci à toi et merci de ta patience, qui à mon égard est nécessaire aujourd'hui.
YANN :°)
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
Excuses-moi !!!
Milles excuses ..............
:'((
je suis confu.
pour tester, j'avais juste selectionné une cellule de la ligne, pas saisi
dedans !!!!
Quel boufon que je suis !!!!
pour le bouton, pas de soucis, je vais le créer, ça je maitrise (enfin, si
je retrouve toutes les facultés de mon cerveau)
Ah là là, que je suis fatigué je crois !!!
Merci à toi et merci de ta patience, qui à mon égard est nécessaire
aujourd'hui.
YANN
:°)
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières
corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement
Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout
seul
Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est
toi qui t'en occupais
Maintenant si tu le souhaites je peux faire
Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne
As tu essayé ???
Excuses-moi !!! Milles excuses .............. :'(( je suis confu. pour tester, j'avais juste selectionné une cellule de la ligne, pas saisi dedans !!!! Quel boufon que je suis !!!! pour le bouton, pas de soucis, je vais le créer, ça je maitrise (enfin, si je retrouve toutes les facultés de mon cerveau)
Ah là là, que je suis fatigué je crois !!!
Merci à toi et merci de ta patience, qui à mon égard est nécessaire aujourd'hui.
YANN :°)
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
Sunburn
re,re par contre, je viens de tester le "nettoyage". en fait, il me faut au moins les 12 premières lignes, et non les 3 comme les tableaux précédents. Désolé de ne pas t'avoir précisé cela avant.....
Bon, je réfléchis, mais je pense qu'il n'y a pas autre chose que je souhaite.
Je viens de faire le nettoyer, et la formule de la colonne R plante, car c'est une formule qui n'inclut pas de somme,mais la valeur de la dernière ligne de la colonne R (si ma mémoire est bonne). Merci pour tout, je crois que là, c'ets ma dernière demande. (Jean Pierre, que je remplace par FFO).
YANN
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
re,re
par contre, je viens de tester le "nettoyage". en fait, il me faut au moins
les 12 premières lignes, et non les 3 comme les tableaux précédents.
Désolé de ne pas t'avoir précisé cela avant.....
Bon, je réfléchis, mais je pense qu'il n'y a pas autre chose que je souhaite.
Je viens de faire le nettoyer, et la formule de la colonne R plante, car
c'est une formule qui n'inclut pas de somme,mais la valeur de la dernière
ligne de la colonne R (si ma mémoire est bonne).
Merci pour tout, je crois que là, c'ets ma dernière demande. (Jean Pierre,
que je remplace par FFO).
YANN
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières
corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement
Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout
seul
Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est
toi qui t'en occupais
Maintenant si tu le souhaites je peux faire
Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne
As tu essayé ???
re,re par contre, je viens de tester le "nettoyage". en fait, il me faut au moins les 12 premières lignes, et non les 3 comme les tableaux précédents. Désolé de ne pas t'avoir précisé cela avant.....
Bon, je réfléchis, mais je pense qu'il n'y a pas autre chose que je souhaite.
Je viens de faire le nettoyer, et la formule de la colonne R plante, car c'est une formule qui n'inclut pas de somme,mais la valeur de la dernière ligne de la colonne R (si ma mémoire est bonne). Merci pour tout, je crois que là, c'ets ma dernière demande. (Jean Pierre, que je remplace par FFO).
YANN
"FFO" a écrit :
Rebonjour à toi
As tu bien lu mes explications concernant ce fichier et mes dernières corrections !!!!!
mes propos :
"Ci-joint ton fichier corrigé avec l'option évennement Pour le bouton "Nettoyage" j'ai cru comprendre que tu te débrouillais tout seul Fais moi signe dans les cas contraire"
Je ne vois pas pourquoi tu attentais un bouton de ma part car pour moi c'est toi qui t'en occupais Maintenant si tu le souhaites je peux faire Il faut que tu me dises où exactement
Parcontre l'ajout des lignes lui fonctionne As tu essayé ???
Merci pour tes réponses
FFO
Rebonjour à toi
Bon compte tenu de l'ampleur du projet qui de plus si je comprends bien touche à sa fin tu es tout escusé
Pour cette petite ultime correction le nombre de lignes à conserver est déterminé par la ligne :
If n > 3 Then
que tu dois mettre pour 12 lignes ainsi :
If n > 12 Then
Pour la formule de la colonne R j'ai rajouté au code cette ligne :
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 12 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1 i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Celà devrait convenir
For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 12 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Celà devrait convenir
For j = 1 To Sheets.Count If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then Sheets(j).Activate i = 0 Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then n = n + 1 End If If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then n = 0 End If If n > 12 Then Range("A9").Offset(i, 0).EntireRow.Select Selection.Delete Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1 i = i - 1 End If i = i + 1 Loop Range("A1").Activate End If Celà devrait convenir
