Discussion :

[ouzal]

Bonjour tout le monde

J'ai un tableau de quelque lignes et colonnes

c'est un tableau qui doit etre rempli par plusieurs utilisateurs, je veu que à chaque fois un utilisateurs ouvre le file, il rempli les données, quand une autre utilisateur arrive aprés, il appui sur un boutton, et tou les données deja saisie par le précedent s'envoi vers une base de donnée commune qui existe sur un fichier xls apart, et le tableau se vide pour que le deuxiéme puisse rentrer ses données à lui. et ainsi de suite.

Comme ca vers la fin il suffit de consulter une seule base de donnée pour voir ce que chaque utilisateur à rentré.

pour clarifier mon probléme, voici des exemples des fichier sources et destination avec explication dans chacun

[mercatog]

à comprendre pour adapter

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
Sub CommandButton1_Click()
Dim awbk As Workbook, wbk As Workbook
Dim NewLig As Long
 
Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wbk = Workbooks.Open("C:\Users\user\Desktop\upload & clear destination.xls")
With wbk.Sheets("Feuil1")   'feuille de destination
   NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   .Range("A" & NewLig & ":C" & NewLig).Value = awbk.Sheets("Table 1").Range("A2:C2").Value
   awbk.Sheets("Table 1").Range("A2:B3").ClearContents
   .Range("D" & NewLig & ":L" & NewLig).Value = awbk.Sheets("Table 1").Range("E3:M3").Value
   awbk.Sheets("Table 1").Range("E3:L3").ClearContents
End With
wbk.Close True
Set wbk = Nothing
Set awbk = Nothing
End Sub

[ouzal]

Merci ennormément ca marche trés bien.

Je suis pas un grand connaisseur de VBA mais j'arrive comême à improviser ton code proposé pour ma situation, cependant j'ai remarqué deux ptits souci:

1/ je sais pas comment ajouter d'autre bouttons similaires pour les autres feuilles (Table 2, Table 3) de l'excel source, car quand je les ajoute et que j'y appui, ils renvoient les données de la (Table 1) au lieu d'envoyer les données de leurs feuille.

2/ si un user oublie d'ecrire la date, donc case date vide dans la ligne correspondante du fichier destination, alors cette ligne s'ecrase lors de l'upload ( bouttonclick) suivant au lieu que la copie de données se fasse en bas.

il serait donc utile d'y remédier par un msgbox insitant à remplir la date ( ou toute case orange ), si le chef cuisinier appui sur le fameux boutton sans qu'il n'écrit la date ou autre case.

Merci ENORMEMENT encore une fois.

[mercatog]

Dans un module standard

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
Sub Archivage(ws As Worksheet)
Dim wbk As Workbook
Dim NewLig As Long
 
Application.ScreenUpdating = False
If Len(ws.Range("A2").Value) * Len(ws.Range("B2").Value) * Len(ws.Range("C2").Value) > 0 Then
   Set wbk = Workbooks.Open("C:\Users\user\Desktop\upload & clear destination.xls")
   With wbk.Sheets("Feuil1")   'feuille de destination
      NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      .Range("A" & NewLig & ":C" & NewLig).Value = ws.Range("A2:C2").Value
      ws.Range("A2:B3").ClearContents
      .Range("D" & NewLig & ":L" & NewLig).Value = ws.Range("E3:M3").Value
      ws.Range("E3:L3").ClearContents
   End With
   wbk.Close True
   Set wbk = Nothing
Else
   MsgBox "données manquantes"
End If
End Sub

Sur chaque feuille, tu crée un bouton activeX et tu lui affecte le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub CommandButton1_Click()
Archivage Sheets("Table 1") 'Feuille Table 1
'Archivage Sheets("Table 2") 'Feuille Table 2
'Archivage Sheets("Table 3") 'Feuille Table 3
End Sub

[ouzal]

Merci ca marche nickel.

Cependant j'ai voulu que l'appuie sur le boutton copie la valeur d'une autre petite cellule : "M2" el le met dans "N" & NewLig dans le fichier de destination.

voici la ligne que j'ai inseré dans le module standard pour faire ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Range("N" & NewLig).Value = ws.Range("M2").Value

Le probléme c que dans la cellule destination "N" &NewLig je retrouve toujours #N/A au lieu de la valeurs qui a vraiment existé dans M2 source avant le click sur le boutton.

Comment faire sachant que c la seule cellule qui me pose ce probléme, tout le reste se copie nickel. (Peut etre parceque c une cellule qui contien formule de SOMME(E2:M2) sachant que toute les cellule de cette intervalle contiennent à leur tours des formules RECHERCHEV(...))

Merci infiniment.

[mercatog]

Je ne vois pas de problème sauf si tu as mal adapté ton fichier
le #N/A pourrait venir de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range(A).value=Range(B).value

dans le cas où range(A) est plus large que range(B)
sinon, j'ai revérifié le code sur tes fichier, il fonctionne

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
Sub Archivage(ws As Worksheet)
Dim wbk As Workbook
Dim NewLig As Long
 
Application.ScreenUpdating = False
If Len(ws.Range("A2").Value) * Len(ws.Range("B2").Value) * Len(ws.Range("C2").Value) > 0 Then
   Set wbk = Workbooks.Open("C:\Users\user\Desktop\upload & clear destination.xls")
   With wbk.Sheets("Feuil1")   'feuille de destination
      NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      .Range("A" & NewLig & ":C" & NewLig).Value = ws.Range("A2:C2").Value
      ws.Range("A2:B3").ClearContents
      .Range("N" & NewLig).Value = ws.Range("M2").Value
      .Range("D" & NewLig & ":L" & NewLig).Value = ws.Range("E3:M3").Value
      ws.Range("E3:L3").ClearContents
   End With
   wbk.Close True
   Set wbk = Nothing
Else
   MsgBox "données manquantes"
End If
End Sub