je n'ai pas tout compris dans ta réponse et le soucis vient de revenir chez ma collègue... alors que ce matin j'avais réussi sur son pc...je ne comprend pas.
Alors le code de bouton est le suivant, il avait été réalisé par un stagiaire, il sert à recupérer sur plusieurs fichiers de controle de mesure poids excel toujours dans le meme format, des données pour les copier coller dans un fichier de compil appelé ecart type et de mettre une date sur le fichier de base pour noter que l'export a bien été réalisé :
Function FichOuvert(F As String) As Boolean
On Error Resume Next
FichOuvert = Not Workbooks(F) Is Nothing
End Function
Sub VBA_Test()
'Private Sub ET_Click()
Dim dl As Integer, derlig As Integer
Dim madate As Date
Dim poids_sachet As Integer, tare_sachet As Integer
Dim TU1 As Integer, TU2 As Integer
Dim produit_emballé As String, code_article, numéro_lot As String, OF
Dim A As String, intitulé_B As String, C As String, D As String, E As String, F As String, G As String, L As String, M As String, N As String, O As String
Dim tablo, tabloR(), k%, i%
'affiche un message d'erreur si la valeur de la tare n'est pas rentrée
If Worksheets("Contrôles sachets").Cells(8, 3).Value = "" Then
MsgBox ("La valeur de la TARE n'a pas été indiquée, veuillez la saisir. ")
End If
'affiche la date et l'heure à laquelle la personne a cliqué sur le bouton, la date est placée en L7. Il faut donc placer le bouton juste au dessus ou au dessous.
With [L7]
.Value = Now
.NumberFormat = "dd/mm/yyyy hh:mm"
End With
'copie les valeurs de "Contrôles sachets"
With Sheets("Contrôles sachets")
dl = .Range("C" & Rows.Count).End(xlUp).Row 'last line
'-------------------- ENTÊTES -- Not useful --------------------------------
' A = .Range("A5")
' B = .Range("G6")
' C = .Range("I6")
' D = .Range("D8")
' E = .Range("A8")
' F = .Range("A10")
' G = .Range("B11")
' L = .Range("G8")
' M = .Range("I8")
' N = .Range("A7")
' O = .Range("A6")
'-------------------- INFORMATIONS DES ENTÊTES--------------------------
madate = .Range("C5")
poids_sachet = .Range("F8")
tare_sachet = .Range("C8")
TU1 = .Range("H8")
TU2 = .Range("J8")
produit_emballé = .Range("C6")
code_article = .Range("C7")
numéro_lot = .Range("H6")
OF = .Range("J6")
'-------------------- BDD---------------------------------------------
tablo = .Range("A11:G" & dl)
k = 0
'colle les valeurs dans auto2
For i = 1 To UBound(tablo, 1) Step 4
If tablo(i, 3) <> "" Then
ReDim Preserve tabloR(1 To 16, 1 To k + 2)
tabloR(2, 2 + k) = DateValue(madate)
tabloR(3, 2 + k) = numéro_lot
tabloR(4, 2 + k) = OF
tabloR(5, 2 + k) = poids_sachet
tabloR(6, 2 + k) = tare_sachet
tabloR(7, 2 + k) = tablo(i, 1)
tabloR(8, 2 + k) = tablo(i, 3)
tabloR(9, 2 + k) = tablo(i, 4)
tabloR(10, 2 + k) = tablo(i, 5)
tabloR(11, 2 + k) = tablo(i, 6)
tabloR(12, 2 + k) = tablo(i, 7)
tabloR(13, 2 + k) = TU1
tabloR(14, 2 + k) = TU2
tabloR(15, 2 + k) = code_article
tabloR(16, 2 + k) = produit_emballé
k = 1 + k
'colle les intitulés des valeurs
tabloR(2, 1) = A
tabloR(3, 1) = B
tabloR(4, 1) = C
tabloR(5, 1) = D
tabloR(6, 1) = E
tabloR(7, 1) = F
tabloR(8, 1) = G
tabloR(9, 1) = G
tabloR(10, 1) = G
tabloR(11, 1) = G
tabloR(12, 1) = G
tabloR(13, 1) = L
tabloR(14, 1) = M
tabloR(15, 1) = N
tabloR(16, 1) = O
End If
Next i
If FichOuvert("ecart-type.xlsx") Then
'Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A2").CurrentRegion.Offset(1, 0).ClearContents
derlig = Workbooks("ecart-type.xlsx").Sheets("auto2").Range("b" & Rows.Count).End(xlUp).Row + 1
On Error Resume Next
Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A" & derlig).Resize(UBound(tabloR, 2), 15) = Application.Transpose(tabloR)
Erase tablo: Erase tabloR
Else
MsgBox "Le classeur ecart-type.xlsx n'est pas ouvert, " & Chr(10) & Chr(10) & "Transfert des données impossible.": Exit Sub
End If
End With
End Sub
----------------------------------------------
Déjà de base, elle a le message d'erreur comme quoi son fichier ecart type n'est pas ouvert.
Elle ouvre pourtant le fameux fichier ecart-type.xlsx...et le transfert des données est impossible.
Cette macro fonctionne bien sur mon pc.
