Macro enregistrer qui ne marche pas
Bonjour à tous,
J'ai hésité à me mettre à la suite d'un autre post ou ouvrir celui-ci mais le cas était un peu différent.
Mon problème: j'ai écrit une macro qui permet de copié les données saisies dans un onglet puis de les coller dans un autre.
Dans l'onglet "Saisies" on écrit sur une ligne, puis on active la macro et on copie dans la première ligne vide de l'onglet que j'ai appelé "Base de donnée BT". (d'autre actions ce fonds dans cette macro comme effacer les données de l'onglet saisies, informer le numéro sur lequel la ligne a été créer, ouvrir un fichier pr insérer des pièces jointes etc..)
Ca sa marche, ce fichier est un fichier partagé, donc j'ai écrit dans la macro, avant et après la macro d'enregistrer le fichier afin de mettre à jour le fichier avant de copier/coller les données, mais c'est la mon problème, les codes "activeworkbook.save", "Thisworkbook.save" ou "Workbooks("Recolte BT-ZONE2.xlsb").Save" ,sont acceptés dans le module, lorsque je déroule avec F8, j'ai l'impression que ca marche cependant ca n'enregistre pas, car le fichier ne se met pas à jour. Si parcontre j'enregistre le fichier manuellement les données se mettent bien à jour.
Avez-vous une idée??
Merci
Salutations
Sub Enregister_sur_Base_Données_BT()
'Activework.Save
Workbooks("Recolte BT-ZONE2.xlsb").Save
If ThisWorkbook.Saved = False Then
MsgBox "PB sauvegarde", vbExclamation, "Sauvegarde"
If ThisWorkbook.Saved = True Then GoTo 70
End If
70:
Dim LastRow As Long
Dim WsDepart As Worksheet
Dim WsDestination As Worksheet
Dim Num_BT As String
Dim Classeur_BT As String
Dim Plg As Range
Dim R As Range
On Error Resume Next
If Not IsEmpty(ActiveSheet.[T12].Value) Then GoTo 28
GoTo 26
28:
Set Plg = ActiveSheet.[A12,H12:K12,U12:Y12,AC12,AF12,AG12,AI12,AO12,AS12,AT12,AY12,DS12].SpecialCells(xlCellTypeBlanks)
If Err Then GoTo 24
Set Plg = Plg.SpecialCells(xlCellTypeBlanks)
If Err Then GoTo 24
Cancel = True
Application.Goto Plg
MsgBox "Champ obligatoire", vbExclamation, "Sauvegarde"
If Plg = ActiveSheet.[A12,H12,I12,J12,K12,U12,V12,W12,X12,Y12,AC12,AF12,AG12,AI12,AO12,AS12,AT12,AY12,DS12].SpecialCells(xlCellTypeBlanks) Then GoTo 25
24: Set WsDestination = Sheets("Base_Données_BT")
Set WsDepart = Sheets("SAISIES")
LastRow = WsDestination.Range("H" & Rows.Count).End(xlUp).Row
Sheets("Base_Données_BT").Select
' recherche de le dernière cellule vide de la colonne H'
'Il faut que la colonne H est des données'
Num_BT = Worksheets("Base_Données_BT").Cells(LastRow + 1, 2)
Sheets("SAISIES").Select
'Num_BT de l'onglet QA Matrix 2016 de la dernière cellule non vide + 1 ligne, colonne 2'
Application.ScreenUpdating = False
WsDepart.Range("A12").Copy
WsDestination.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
' ..... etc
WsDepart.Range("DW12").Copy
WsDestination.Range("DW" & LastRow + 1).PasteSpecial xlPasteValues
'copie des valeurs des cellules ci-dessous dans la première cellule vide de l'onglet Base de données BT
'(ex: copie de H11 dans la première cellule vide de la colonne H de l'onglet QA Matrix 2016)'
WsDepart.Range("A12:J12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("T12:U12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("W12:AC12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("AF12:AO12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("AR12:AV12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("AX12:BI12").ClearContents
Application.ScreenUpdating = False
WsDepart.Range("BU12:DW12").ClearContents
Application.ScreenUpdating = False
'Efface les données de A12:J12 puis T12:U12 ect de l'ongelt "saisie"'
Set WsDestination = Nothing
Set WsDepart = Nothing
'Affiche le numéro de la cellule situé ligne ,col
Sheets("SAISIES").Select
Cells(3, 6) = Num_BT
Workbooks("Recolte BT-ZONE2.xlsb").Save
Num_BT = "L:\BDONNEES\BT\Recolte BJ Zone2\Pièces jointes-BT à Imprimer\Pièces_jointes\" + Num_BT + ".xls"
Classeur_BT = ActiveWorkbook.Name
'Ouverture du fichier
Workbooks.Open Filename:=Num_BT
ThisWorkbook.Save
If Err Then GoTo 25 Else GoTo 25
26: MsgBox "Champs verts et rouges obligatoires", vbExclamation, "Sauvegarde"
25: Workbooks("Recolte BT-ZONE2.xlsb").Save
End Sub
Bonjour,
C'est quoi ce code spaghettis ???
Tout d'abords, utilises les balises Code (voir le bouton dédié) pour encadrer ton code.
et ensuite, repenses ton code en virant tous ces Goto qui le rendent difficile à interpréter et difficile à maintenir si c'est une autre personne que toi qui doit par la suite s'en occuper.