Agrémenter lors du déplacement

Bonjour

J'ai cette macro pour archiver des lignes. Je voudrais qu'en colonne BE il y est un numéro d'archive ajouter.

Comment faire ?

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

If Not Application.Intersect(Target, Range("BA2:BA70 ")) Is Nothing Then

   With Target

      With .Font

         .Name = "Wingdings"
         .Size = 10
         .Bold = True

      End With

   .Value = IIf(.Value = "", "ü", "")

   End With

   Dim DerL As Integer
   Dim shA As Worksheet
   Set shA = Sheets("Archives")
   DerL = shA.Range("BA" & Rows.Count).End(xlUp).Row + 1

   With Worksheets("Effectif")

        .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "BA")).Copy shA.Range("A" & DerL)
        shA.Range("BB" & DerL) = InputBox("A quelle date est parti le jeune ?" & Chr(10) & "Veuillez saisir la date au format JJ/MM/AAAA", "Date de départ")
        shA.Range("BD" & DerL) = InputBox("Avec quel partenaire est parti le jeune ?" & Chr(10) & "Veuillez saisir le partenaire", "ADMA, CAPS, CHRS, FJT, SAS, SHAMNA, autre ?")
        shA.Range("BC" & DerL) = InputBox("Dans quelle ville est parti le jeune ?" & Chr(10) & "Veuillez saisir le lieu", "Ville")
        .Rows(Target.Row).Delete

    End With

Cancel = True

 End If

End Sub

J'ai essayé cela, mais le nombre reste à 1

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

If Not Application.Intersect(Target, Range("BA2:BA70 ")) Is Nothing Then

   With Target

      With .Font

         .Name = "Wingdings"
         .Size = 10
         .Bold = True

      End With

   .Value = IIf(.Value = "", "ü", "")

   End With

   Dim DerL As Integer
   Dim shA As Worksheet
   Set shA = Sheets("Archives")
   DerL = shA.Range("BA" & Rows.Count).End(xlUp).Row + 1

   With Worksheets("Effectif")

        .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "BA")).Copy shA.Range("A" & DerL)
        shA.Range("BB" & DerL) = InputBox("A quelle date est parti le jeune ?" & Chr(10) & "Veuillez saisir la date au format JJ/MM/AAAA", "Date de départ")
        shA.Range("BC" & DerL) = InputBox("Dans quelle ville est parti le jeune ?" & Chr(10) & "Veuillez saisir le lieu", "Ville")
        shA.Range("BD" & DerL) = InputBox("Avec quel partenaire est parti le jeune ?" & Chr(10) & "Veuillez saisir le partenaire", "ADMA, CAPS, CHRS, FJT, SAS, SHAMNA, autre ?")
        shA.Range("BE" & DerL) = Application.Max(Columns("BE")) + 1

        .Rows(Target.Row).Delete

    End With

Cancel = True

 End If

End Sub

Bonjour

Je pense qu'un extrait de ton code serait bienvenue.

BCBDBE
xxxeer1
yyy

aaa

2
zzzfdf?

Le point d'interrogation c'est BE3+1 ? c'est ce que tu cherche ?

Bonjour

Je ne comprends pas ta demande de code puisque je l'ai indiqué.

Mon souhait est qu'à chaque ligne déplacée sur la feuille archive, un numéro soit ajouter en colonne BE. Par exemple, si c'est la 102éme ligne déplacée, en (BE;102) il y ai le numéro 102

Pourquoi la fonction shA.Range("BE" & DerL) = Application.Max(Columns("BE")) + 1 avec Columns au lieu de Row.

Excuse moi mais je veux bien comprendre.

C'est du copier coller d'une formule internet.

Rechercher des sujets similaires à "agrementer lors deplacement"