Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Copie d'une ligne dans une autre feuille aprés mise a jour sous condition

Copie d'une ligne dans une autre feuille aprés mise a jour sous condition

2 réponses
Avatar
lograd
Bonjour =E0 tous,
cela fait un moment que je scrute ce groupe et que je m'inspire des
id=E9es et r=E9flexions de chacun, mais aujourd'huis je n'y arrive
plus.En fait je ne comprend pas.Ah, il faudrait que je vous
expliquent.J'ai un tableau sur la "Feuil1" compos=E9 de 6 colonnes et un
nombre de ligne ind=E9fini (sauf par excel bien sur 65000).Lorsque je
veux supprimer une ligne j'ai cr=E9=E9 une macro avec un bouton qui me
passe cette ligne a supprimer en rouge et rajoute "OK" en colonne
8=2ECette macro fonctionne tr=E9s bien.mais j'ai rajout=E9 un code dans la
"Feuil1" qui me permet de copier cette ligne, supprimer, dans la
"Feuil2" avec ajout en bout de ligne de la "Feuil1" la date de
suppression.
Mais l=E0 ou cela ne fonctionne pas c'est =E0 la copie sur la "Feuil2",
car je me retrouve avec les 200 premieres lignes remplis avec ma ligne
supprim=E9e.
Comment n'avoir qu'une seul ligne de remplie ?
Voila les codes :

Macro du bouton :

Sub color6colonneeteffacefeuille2couleur()
With ActiveCell
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Interior.ColorIndex
=3D 3
.Offset(0, 7) =3D "OK"
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Select
.Offset(0, 0).Select
Sheets("Feuil2").Select
Cells.Select
Selection.Interior.ColorIndex =3D xlNone
Range("A1").Select
Columns("H:H").Select
Selection.ClearContents
Range("A1").Select
Sheets("Feuil1").Select
.Offset(0, 0).Select
End With
End Sub

Et voila le code dans la "Feuil1":

Dim Annuler As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Range(Target.Address) =3D UCase(Target)
If Target.Column =3D 8 Then
With Sheets("Feuil2") 'ou autre nom
If Target.Value =3D "OK" Then
Dim NextLi&
NextLi =3D .Cells(Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(.Cells(NextLi, 1)) Then _
NextLi =3D NextLi + 1
Target.EntireRow.Copy .Cells(NextLi, 1)
ElseIf Target.Value =3D "" Then
Dim pos
On Error Resume Next
pos =3D Application.Match(Annuler, .Range("A:A"), 0)
On Error GoTo 0
If Not IsError(pos) Then .Cells(pos, 1).EntireRow.Delete
End If
End With
End If
If Target.Column =3D Range("H:H").Column Then
Application.EnableEvents =3D False
For Each c In Intersect(Target, Range("H:H"))
c.Offset(, 1) =3D Format(Date, "dd/mm/yy")
Next
Application.EnableEvents =3D True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Annuler =3D Target.Value
End Sub

Merci d'avance, maintenant c'est a vous de jouer.
Je suis sur que ce n'est rien du tout =E0 faire, mais je bloque.

PS: La date s'affiche ainsi 12/11/2006 pour 11 decembre 2006, c'est le
dernier PB.
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
lograd
Re bonjour à tous,
pour répondre à la question sur la date j'ai trouvé, c'était simple
:

Au lieu de :
c.Offset(, 1) = Format(Date, "dd/mm/yy")
Mettre:
c.Offset(,1)=Format(Date, "mm/dd/yy")

et le tour est joué.
Simple mais bon il fallait le trouver :).

De plus j'ai une ligne de trops dans la macro du bouton, après
.Offset(0, 7) = "OK"

Il faut enlever :
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Select

Qui ne sert a rien.

Et enfin j'ai trouvé pour l'histoire des 200 lignes qui se copient
dans la Feuil2, au lieu d'une seul.
Il faut enlever la ligne :
Range(Target.Address) = UCase(Target)

Cette ligne est génial en temps normal parceq'elle permet de mettre
automatiquement toute les cellules en majuscules.Pas besoin de
selectionner une cellule et d'exécuter une macro puisque la ligne de
code est dans la Feuil, par conséquent dés la validation de la
cellule celle ci passe automatiquement MAJUSCULE.

J'espere que tout cela pourra servir à quelqu'un, et que j'ai été
assez clair.





Bonjour à tous,
cela fait un moment que je scrute ce groupe et que je m'inspire des
idées et réflexions de chacun, mais aujourd'huis je n'y arrive
plus.En fait je ne comprend pas.Ah, il faudrait que je vous
expliquent.J'ai un tableau sur la "Feuil1" composé de 6 colonnes et un
nombre de ligne indéfini (sauf par excel bien sur 65000).Lorsque je
veux supprimer une ligne j'ai créé une macro avec un bouton qui me
passe cette ligne a supprimer en rouge et rajoute "OK" en colonne
8.Cette macro fonctionne trés bien.mais j'ai rajouté un code dans la
"Feuil1" qui me permet de copier cette ligne, supprimer, dans la
"Feuil2" avec ajout en bout de ligne de la "Feuil1" la date de
suppression.
Mais là ou cela ne fonctionne pas c'est à la copie sur la "Feuil2",
car je me retrouve avec les 200 premieres lignes remplis avec ma ligne
supprimée.
Comment n'avoir qu'une seul ligne de remplie ?
Voila les codes :

Macro du bouton :

Sub color6colonneeteffacefeuille2couleur()
With ActiveCell
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Interior.ColorIndex
= 3
.Offset(0, 7) = "OK"
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Select
.Offset(0, 0).Select
Sheets("Feuil2").Select
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
Columns("H:H").Select
Selection.ClearContents
Range("A1").Select
Sheets("Feuil1").Select
.Offset(0, 0).Select
End With
End Sub

Et voila le code dans la "Feuil1":

Dim Annuler As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Range(Target.Address) = UCase(Target)
If Target.Column = 8 Then
With Sheets("Feuil2") 'ou autre nom
If Target.Value = "OK" Then
Dim NextLi&
NextLi = .Cells(Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(.Cells(NextLi, 1)) Then _
NextLi = NextLi + 1
Target.EntireRow.Copy .Cells(NextLi, 1)
ElseIf Target.Value = "" Then
Dim pos
On Error Resume Next
pos = Application.Match(Annuler, .Range("A:A"), 0)
On Error GoTo 0
If Not IsError(pos) Then .Cells(pos, 1).EntireRow.Delete
End If
End With
End If
If Target.Column = Range("H:H").Column Then
Application.EnableEvents = False
For Each c In Intersect(Target, Range("H:H"))
c.Offset(, 1) = Format(Date, "dd/mm/yy")
Next
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Annuler = Target.Value
End Sub

Merci d'avance, maintenant c'est a vous de jouer.
Je suis sur que ce n'est rien du tout à faire, mais je bloque.

PS: La date s'affiche ainsi 12/11/2006 pour 11 decembre 2006, c'est le
dernier PB.


Avatar
lograd
Re bonjour à tous,
pour répondre à la question sur la date j'ai trouvé, c'était simple
:

Au lieu de :
c.Offset(, 1) = Format(Date, "dd/mm/yy")
Mettre:
c.Offset(,1)=Format(Date, "mm/dd/yy")

et le tour est joué.
Simple mais bon il fallait le trouver :).

De plus j'ai une ligne de trops dans la macro du bouton, après
.Offset(0, 7) = "OK"

Il faut enlever :
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Select

Qui ne sert a rien.

Et enfin j'ai trouvé pour l'histoire des 200 lignes qui se copient
dans la Feuil2, au lieu d'une seul.
Il faut enlever la ligne :
Range(Target.Address) = UCase(Target)

Cette ligne est génial en temps normal parceq'elle permet de mettre
automatiquement toute les cellules en majuscules.Pas besoin de
selectionner une cellule et d'exécuter une macro puisque la ligne de
code est dans la Feuil, par conséquent dés la validation de la
cellule celle ci passe automatiquement MAJUSCULE.

J'espere que tout cela pourra servir à quelqu'un, et que j'ai été
assez clair.

PS:Comment mettre des couleurs lorsque l'on pose une question ?


Bonjour à tous,
cela fait un moment que je scrute ce groupe et que je m'inspire des
idées et réflexions de chacun, mais aujourd'huis je n'y arrive
plus.En fait je ne comprend pas.Ah, il faudrait que je vous
expliquent.J'ai un tableau sur la "Feuil1" composé de 6 colonnes et un
nombre de ligne indéfini (sauf par excel bien sur 65000).Lorsque je
veux supprimer une ligne j'ai créé une macro avec un bouton qui me
passe cette ligne a supprimer en rouge et rajoute "OK" en colonne
8.Cette macro fonctionne trés bien.mais j'ai rajouté un code dans la
"Feuil1" qui me permet de copier cette ligne, supprimer, dans la
"Feuil2" avec ajout en bout de ligne de la "Feuil1" la date de
suppression.
Mais là ou cela ne fonctionne pas c'est à la copie sur la "Feuil2",
car je me retrouve avec les 200 premieres lignes remplis avec ma ligne
supprimée.
Comment n'avoir qu'une seul ligne de remplie ?
Voila les codes :

Macro du bouton :

Sub color6colonneeteffacefeuille2couleur()
With ActiveCell
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Interior.ColorIndex
= 3
.Offset(0, 7) = "OK"
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Select
.Offset(0, 0).Select
Sheets("Feuil2").Select
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
Columns("H:H").Select
Selection.ClearContents
Range("A1").Select
Sheets("Feuil1").Select
.Offset(0, 0).Select
End With
End Sub

Et voila le code dans la "Feuil1":

Dim Annuler As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Range(Target.Address) = UCase(Target)
If Target.Column = 8 Then
With Sheets("Feuil2") 'ou autre nom
If Target.Value = "OK" Then
Dim NextLi&
NextLi = .Cells(Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(.Cells(NextLi, 1)) Then _
NextLi = NextLi + 1
Target.EntireRow.Copy .Cells(NextLi, 1)
ElseIf Target.Value = "" Then
Dim pos
On Error Resume Next
pos = Application.Match(Annuler, .Range("A:A"), 0)
On Error GoTo 0
If Not IsError(pos) Then .Cells(pos, 1).EntireRow.Delete
End If
End With
End If
If Target.Column = Range("H:H").Column Then
Application.EnableEvents = False
For Each c In Intersect(Target, Range("H:H"))
c.Offset(, 1) = Format(Date, "dd/mm/yy")
Next
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Annuler = Target.Value
End Sub

Merci d'avance, maintenant c'est a vous de jouer.
Je suis sur que ce n'est rien du tout à faire, mais je bloque.

PS: La date s'affiche ainsi 12/11/2006 pour 11 decembre 2006, c'est le
dernier PB.