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

Le
lograd
Bonjour tous,
cela fait un moment que je scrute ce groupe et que je m'inspire des
ides et rflexions 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 indfini (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 trs 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
supprime.
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.
Vos réponses
Trier par : date / pertinence
lograd
Le #4115431
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.


lograd
Le #4115391
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.


Publicité
Poster une réponse
Anonyme