besoin d'un code VBA pour archivage

[johnlhx]

bonjour je cherche un code vba pour mon probleme suivant

j'ai plusieurs feuille sur un classeur mais pour mon probleme seulement 2 feuilles nous interresse
la feuil2 "Archives"
la feuil3 "Listes factures"

Dans ma feuille listes factures je voudrais que quand dans ma colonne "J", le mot "réglé" aparait (il apparait quand je tape une date de reglement), un petit bouton ou autre apparait dans la colonne "P" qui lui permettrer en un ou double click sur celui ci, d'archiver la ligne complete dans la feuille Archives, tout en supprimant les données de la lignes, mais attention pas les formules qui se trouve dans certaines celulles de cette lignes.

a vos reponses merci

 

[yeti_yeti]

Bonjour johnlhx,

Plutôt que faire apparaître un bouton, je suis parti sur l'idée de simplement sélectionner la ligne entière pour archiver...
La macro ci-dessous est à entrer dans la feuille "Listes Factures"... et à adapter la partie "Déclaration constantes"

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet, msg As String, ArchTxt As String, ArchCol As Integer 'Constantes
Dim aRow As Integer, r As Integer, sRow As Range 'Variables

'Déclaration constantes
Set ws = ThisWorkbook.Sheets("Archives") 'Nom de la feuille Archives
msg = "Voulez-vous vraiment archiver cette ligne ?" 'Message de confirmation avant archivage
ArchTxt = "Réglé" 'Le texte qui définit si une ligne peut être est archivée
ArchCol = 10 'No colonne où doit se trouver ArchTxT

'Déclaration variables
aRow = ActiveCell.Row 'Numéro de la ligne active
r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 'Première ligne vide de la feuille archive
Set sRow = ActiveCell.EntireRow 'Ligne sélectionnée

'###############
'# Début macro #
'###############
    'Si une seule ligne est entièrement sélectionnée et qu'elle comprend le texte d'archivage à l'endroit requis
    If Selection.Rows.Count = 1 And Selection.Columns.Count = ActiveSheet.Columns.Count And UCase(Cells(aRow, ArchCol).Value) = UCase(ArchTxt) Then
        If MsgBox(msg, vbYesNo) = vbYes Then 'On affiche le message de confirmation et si confirmé
            With sRow
                .Copy Destination:=ws.Rows(r) 'On copie la ligne et la colle dans archive
                .Delete 'On supprime la ligne
            End With
        End If
    End If
 
End Sub