Bonjour à toutes et à tous,
J'ai mis en place ce code qui devrait me permettre de copier la dernière ligne saisie vers un autre tableau en faisant un double-clic en fin de saisie,
mais malheureusement cela ne fonctionne pas et je ne trouve pas la source de mon erreur.
Les deux tableaux sont des tableaux structurés.

Serait-il possible de faire la copie au moment du changement de ligne par tabulation ?

Voici le code qui se trouve dans la feuille "Arch_Bât". Je vous joint également une partie de mon fichier pour exemple.
J'ai modifié le fichier joint afin qu'il soit plus léger et plus court.
Test.xlsm

Merci par avance pour l'aide que vous pourrez m'apporter.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
'Procédure de copie automatique des données saisies
'vers la feuille "Général" après un double-clique en fin de ligne après la saisie
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Ligne_Cours As Long
Dim Nbre_Lignes_Max As Long
Application.ScreenUpdating = False
 
    'On désactive les filtres si il y en a
        On Error Resume Next
            ThisWorkbook.Sheets("Général").ShowAllData
        On Error GoTo 0
 
    'On affiche les lignes qui pourraient être masquées
        ThisWorkbook.Sheets("Général").Rows("1:1048576").EntireRow.Hidden = False
 
    'On cherche le nombre de lignes déjà remplies
        Nbre_Lignes_Max = ThisWorkbook.Sheets("Général").Range("Q1048576").End(xlUp).Row
 
    'Si il y a des références
        If Nbre_Lignes_Max > 1 Then
 
        'On parcoure la colonne Q en commençant par la fin
            For Ligne_Cours = Nbre_Lignes_Max To 1 Step -1
 
            'Si "DB" est trouvé
                If LCase(ThisWorkbook.Sheets("Général").Range("Q" & Ligne_Cours)) = "DB" Then
 
            'On insére une ligne après la dernière référence trouvée
                ThisWorkbook.Sheets("Général").Rows(Ligne_Cours + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                ThisWorkbook.Sheets("Général").Rows(Ligne_Cours + 1).Select
                    With Selection.Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
 
            'On complète la colonne "Q" avec la nouvelle ligne et les lettres "DB"
                ThisWorkbook.Sheets("Général").Range("Q" & Ligne_Cours + 1) = "DB"
 
                End If
            Exit Sub
 
        Next Ligne_Cours
        End If
Application.ScreenUpdating = True
End Sub
Test.xlsm