Ajout ligne pour copier/coller VBA

Version imprimable

Bonjour à tous,

J'ai toujours le même tableau que je viens copier/coller sur une autre feuille d'un autre classeur excel.
Voilà le code réalisé pour le copier/coller:

Code:

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
 
Sub BDD_Quantité()
 
Dim Chemin As String, ChampDest As Integer, ChampDest1 As Integer
Dim Nomprojet, Lieu, Début_trx, Fin_trx As String
Dim Ouvrage, Unité, Q_existant, Q_projet, Potentiel, Q_possible, Q_restant As String
Dim Chrono_FOD As Double
 
Dim MaPlage As Range
 
 
Nomprojet = Sheets("Projet").Range("F11").Value
Lieu = Sheets("Projet").Range("F12").Value
Début_trx = Sheets("Projet").Range("F13").Value
Fin_trx = Sheets("Projet").Range("F14").Value
 
 
    With Workbooks("QUANTITATIF_PROJET.xlsm").Worksheets("Quantités")
        Set MaPlage = Application.Union(.Range("A8:N21"), .Range("A23:N43"), .Range("A46:N50"), .Range("A53:N58"), .Range("A61:N69"), .Range("A71:N74"), Range("A76:N79"), .Range("A82:N88"), .Range("A90:N95"), .Range("A98:N109"), .Range("A111:N208"), .Range("A210:N210"))
    End With
    MaPlage.Copy
    Chemin = "C:\Users\Documents\Economie circulaire\Outil EC\Lien dossier\Etat navette.xlsm"
 
    'Ouvre l'état navette si ce n'est pas le cas
    On Error Resume Next
    Workbooks("Etat navette.xlsm").Sheets("BDD_métré").Activate
    If Err Then Err.Clear: Workbooks.Open Filename:=Chemin
    Workbooks("Etat navette.xlsm").Worksheets("BDD_métré").Activate
    ChampDest = ActiveWorkbook.Sheets("BDD_métré").Range("E" & Rows.Count).End(xlUp).Row + 1
    Range("A" & ChampDest).Select
    ActiveSheet.Paste
 
 
End Sub

Cependant, je souhaiterai peremttre l'ajout, c'est à dire que si une personne ajoute une ligne, elle se copie/colle également dans le classeur excel! Comment faire?

Merci pour votre aide! :)

Bonjour,
J'ai ce code qui me permet après un double-clic de pouvoir copier la dernière ligne saisie, peut-être pourrez-vous l'adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Procédure de copie automatique des données saisies
'Transfert vers la feuille "Général" après un double-clic
Application.ScreenUpdating = False
Dim F As Worksheet
Dim C As Range
 
    Set F = Worksheets("Général")
    Set C = F.Cells(F.Rows.Count, "C").End(xlUp).Offset(1, -2)
            C.EntireColumn
            Target.EntireColumn.Copy C.Offset(-1)
            Target.EntireRow.Cells(1, 1).Offset(1).Activate
    Cancel = True
 
Application.ScreenUpdating = True
End Sub

25/06/2021, 11h53
lucasgaetan

Bonjour Marc_Ingé,
As tu regardé du coté des plages nommées ?
Sous l’onglet Formules, dans le groupe Noms définis, cliquez sur Gestionnaire de noms.
Ici tu peux nommer un group de cellules, dans ton cas:
A8:N21 --> Plage1
A23:N43 --> Plage2
A46:N50 --> Plage3
etc...
Ensuite dans ton code, tu remplaces l'adresse des cellules par leurs noms, pour exemple:

Code:

Set MaPlage = Application.Union(.Range("Plage1"), .Range("Plage2"), .Range("Plage3"), etc...

Lorsqu'une personne insèrera une ligne dans une de ces plages elle en fera partie.

Le nom des plages est arbitraire, à toi de mettre un nom cohérant. plus d'info sous :
https://support.microsoft.com/fr-fr/...4-9f61bd5c64e4

@+