Copier/coller une ligne sur changement de valeur d'une cellule

lexxor

XLDnaute Nouveau
Bonjour,

Je tiens tout d'abord a remercie la communauté Excel Downloads pour leur aide et en espérant que quelqu'un me mettera sur la bonne voie.

j'ai réalisé une première macro permettant d'envoyer des mails personnalisés à une liste de destinataire. Ci ceux non pas remis des documents justificatifs dans un délais précis.

Je rencontre des problèmes pour mon archivage automatique lorsque je signale que des différents documents ont bien été remis. Je veux réaliser une copie de la ligne (ou tous les documents ont été remis) et la coller dans la première ligne vide d'une autre feuille du classeur.

J'ai essayé de le faire de nombreuse façon ( Boucle for, Fonction IsEmpty...) mais rien y fait pourtant je ne vois pas où est la complexité.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("E1:E999")) Is Nothing Then

Dim j As Integer
Dim i As Integer
j = 2

For i = 2 To 999

If Sheets("BDD").Cells(i, 5).Value = "Oui" Then
    Sheets("BDD").Range(("A" & i) & ":" & ("M" & i)).Select
    Selection.Copy
    Archivage_Ok = True
    Sheets("Historique_suivi").Select




If Archivage_Ok = True Then
Range("A1").Select

Do While Not (IsEmpty(ActiveCell))
    Cells(j, 14).Value = "Complete"
    j = j + 1
Loop


        Sheets("Historique_suivi").Activate 'sélectionne la feuille du transfert
        Sheets("Historique_suivi").Range(("A" & j) & ":" & ("M" & j)).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Archivage_Ok = False
       

        'Sheets("Historique_suivi").Activate 'sélectionne la feuille du transfert
        'Range("A65000").End(xlUp).Offset(1).Select 'recherche la première cellule vide
        'Rows(ActiveCell.Row).Select
        'ActiveSheet.Paste 'copie les données

        'Sheets("Historique_suivi").Range("A" & j & ":M" & j).Paste
        'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        'False, Transpose:=False
        'Application.CutCopyMode = False
       
End If

Sheets("BDD").Select
Cells(i, 9).Value = ""
Cells(i, 8).Value = ""
Cells(i, 7).Value = ""
Cells(i, 6).Value = ""
Cells(i, 12).Value = "Non Remis"
Cells(i, 11).Value = "Non Remis"
Cells(i, 10).Value = "Non Remis"
Cells(i, 13).Value = Cells(9, 19).Value


End If
Next i
End If

End Sub

Je vous remercie de votre aide.

Respectueusement Alexandre
 

Pièces jointes

  • Mission1V5.xlsm
    110.6 KB · Affichages: 41
Dernière édition:

lexxor

XLDnaute Nouveau
Re : Defaut macro Excel : copie/coller d'une ligne en fonction d'une cellule

S'il vous plait je sature je pense avoir tout essayé et a chaque fois cest la meme ligne qui pose problème :
Sheets("Historique_suivi").Range(("A" & j) & ":" & ("M" & j)).Select
ou Sheets("Historique_suivi").Range("A" & j & ":M" & j).Paste
ou Rows(ActiveCell.Row).Select

Merci de votre aide
 

Dranreb

XLDnaute Barbatruc
Re : Personne n'arrive a me donne un coup de pousse ?

Bonjour.
Commencez par contracer tous les .Select: Selection., ça ne sert à rien.
Chez moi ça plante sur Range("A1").Select parce qu'en l'absence de CodeName de feuille devant suivi d'un point, il assume la feuille correspondant à l'objet Worksheet auquel est attaché le code. Or cette feuille n'est plus active parce qu'il y a un Sheets("Historique_suivi").Select juste avant, or on ne peut pas sélectionner une cellule d'une feuille qui n'est pas active.
 

gilbert_RGI

XLDnaute Barbatruc
Re : Personne n'arrive a me donne un coup de pousse ?

Bonjour

remplacer votre code par celui ci

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("E1:E999")) Is Nothing Then
Dim j As Integer
Dim i As Integer
Application.ScreenUpdating = False
g = Sheets("Historique_suivi").Range("E65536").End(xlUp).Row + 1

For i = 2 To 999
If Sheets("BDD").Cells(i, 5).Value = "Oui" Then
Sheets("BDD").Range(("A" & i) & ":" & ("M" & i)).Copy Sheets("Historique_suivi").Range("A" & g & ":M" & g)
Archivage_Ok = False
g = g + 1
End If
With Sheets("BDD")
.Cells(i, 9).Value = ""
.Cells(i, 8).Value = ""
.Cells(i, 7).Value = ""
.Cells(i, 6).Value = ""
.Cells(i, 12).Value = "Non Remis"
.Cells(i, 11).Value = "Non Remis"
.Cells(i, 10).Value = "Non Remis"
.Cells(i, 13).Value = .Cells(9, 19).Value
End With

Next i
End If
Application.ScreenUpdating = True
MsgBox "Terminé"

End Sub

puis dites si c'est votre attente

PS : nous ne sommes pas aux pièces ;-))))
 
Dernière édition:

excfl

XLDnaute Barbatruc
Re : Personne n'arrive a me donne un coup de pousse ?

Bonsoir le forum,

15p0qid.gif


ou ?

29p5kcp.gif


excfl
 

lexxor

XLDnaute Nouveau
Re : Personne n'arrive a me donne un coup de pousse ?

Je vous remercie !

C'est ce que je voulais mais par contre au lieu du double clique sur la colonne E pour lancer la macro il n'est pas possible que se soit suite à un changement de la valeur de la colonne : Passage de Non à Oui ?

Encore merci de votre aide
 

lexxor

XLDnaute Nouveau
Re : Copier/coller une ligne sur changement de valeur d'une cellule

Je viens d'essayer mais ducoup lorsque je clique dans n'importe qu'elle cellule la macro se lance. Il est même pas nécessaire que je la modifie et il prend pas en compte la colonne non plus. As tu une idée ?
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
547