Discussion :

[Marc_Ingé]

Bonjour,

J'ai deux fichiers Excel: un qui contient un tableau à remplir par l'utilisateur et un avec sa base de données.

Je souhaiterai que l'ensemble des lignes de mon tableau s'insère dans ma base de données lorsque on appuie sur un bouton.
Exemple avec la première ligne:
Mon tableau contient plusieurs lignes avec plusieurs matériaux et quantités (qui vont changer selon le projet) à remplir par l'utilisateur, exemple:


Et je souhaiterai que ma base de données contiennent toutes les lignes de ce tableau avec toutes les quantités des projets insérés, ma base donnée:


J'ai testé un code VBA mais cela va être compliqué à réaliser si je dois écrire cela pour les 250 lignes (car 250 initulés d'ouvrage différents) de mon tableau... Il faudrait sans doute faire une boucle, mais je m'y connais pas du tout en codage VBA...

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
Sub Enregistrement_Quantité_Etat_Navette()
'
' Etat_Navette Macro
'
Dim Chemin As String, ChampDest As Integer, ChampDest1 As Integer
Dim Nomprojet, Lieu, Région, 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
 
Nomprojet = Sheets("Quantités").Range("D1").Value
'Chrono_FOD = Range("K3").Value
Lieu = Sheets("Quantités").Range("D2").Value
Début_trx = Sheets("Quantités").Range("D3").Value
Fin_trx = Sheets("Quantités").Range("D4").Value
 
Ouvrage = Sheets("Quantités").Range("Initiulé1").ListObject.ListRows
 
 
 
 
Chemin = "C:\Users\Documents\Economie\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
 
    'Accès à la dernière ligne libre de l'état navette
    ChampDest = ActiveWorkbook.Sheets("BDD_métré").Range("B" & Rows.Count).End(xlUp).Row + 1
 
 
    Range("A" & ChampDest).Value = Début_trx
    Range("B" & ChampDest).Value = Fin_trx
    Range("C" & ChampDest).Value = Lieu
    Range("D" & ChampDest).Value = Nomprojet
    Range("E" & ChampDest).ListObject.ListRows = Ouvrage
 
 
End Sub

Merci pour votre précieuse aide, j'en ai vraiment besoin!
Bonne journée à tous!

[EricDgn]

Bonjour,

Word = traitement de textes, Excel = feuille de calculs, Access = base de données.
J'ai l'impression que vous êtes mal parti à vouloir utiliser Excel comme base de données. Access est fait pour cela, Excel pas vraiment.

Dans votre code, vous copiez 5 éléments disposés en colonne (D1 à D5) pour les placer ensuite sur une ligne, mais sur vos images cela n'apparait pas (on ne voit pas les n° de lignes et de colonnes). Pour moi, pas possible de comprendre ce que vous cherchez à faire.

Cordialement.

[Marc_Ingé]

Bonjour,
Merci pour votre réponse.

Je souhaite copier/coller les éléments du tableau dans une autre feuille et que cela d’incrémente à chaque fois qu'on appuie sur un bouton dans la feuille


J'ai essayé ce code mais il ne marche pas, une personne plus expérimentée aurait-elle une solution?

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
Sub Macopie()
    Dim shS As Worksheet 'Source
    Dim shD As Worksheet 'destination
    Dim rCh As Range ' Nom a chercher
    Dim iDest As Integer 'Ligne de destination dans feuille
    Dim Chemin As String
 
    Chemin = "C:\Users\Documents\Economie\Outil EC\Lien dossier\Etat navette.xlsm"
    Workbooks("Etat navette.xlsm").Sheets("Recherche_quantité").Activate
        'Accès à la dernière ligne libre de l'état navette
    ChampDest = ActiveWorkbook.Sheets("Recherche_quantité").Range("B" & Rows.Count).End(xlUp).Row + 1
 
 
 
    Set shS = ThisWorkbook.Worksheets("Quantité") ' Feuille source
    Set shD = ActiveWorkbook.Sheets("Recherche_quantité") ' Feuille destination
    Set rCh = shS.Range("A8") ' Cellule contenant le nom à chercher
    On Error Resume Next 'Pour éviter les messages d'erreur sur recherche infructueuse
    iDest = Application.WorksheetFunction.Match(rCh, shD.Range("A:A"), 0)
    On Error GoTo 0
    If iDest = 0 Then 'Cas ou pas trouvé on rajoute une ligne
        iDest = shD.Range("A65535").End(xlUp).Row + 1
    End If
    shS.Range("A3:D3").Copy shD.Cells(iDest, "A")
End Sub