Classeur mode L1C1 après 2ème execution d'une macro
Bonjour,
J'ai un petit problème qui me dépasse avec du VBA.
Chaque mois, je dois mettre à jour un template contenant une liste d'employés en France. J'ai donc 3 fichiers :
- 1 fichier de travail dans lequel sont les macros (Wb / Ws dans le code)
1 fichier de référence avec l'ensemble du staff de toutes les entités (WbStaff / WsStaff)
1 Template avec les employés (WbTemplate / WsTemplate)
Je me sers donc de WbStaff et WbTemplate pour mettre à jour Wb. La macro fonctionne, sauf si je la lance deux fois de suite ... Au deuxième lancement, impossible de copier les données de WbStaff car le fichier se met en mode L1C1... L'erreur se situe au niveau de
WsStaff.Range("A12:AD12").CopyCi-dessous mes codes :
Définition des noms :
Option Explicit
Sub Define_Names()
WbTemplateNDFPath = Range("WbTemplateNDF").Value
WsTemplateNDFName = Range("WsTemplateNDF").Value
WbStaffPath = Range("WbStaff").Value
WsStaffName = Range("WsStaff").Value
End SubDéclarations
Option Explicit
Public RefMonth As String
Public WbStaffPath As String
Public WsStaffName As String
Public WbTemplateNDFPath As String
Public WsTemplateNDFName As String
Public wb As Workbook
Public ws As Worksheet
Public WbTemplate As Workbook
Public WsTemplate As Worksheet
Public WbStaff As Workbook
Public WsStaff As Worksheet
Public WsDest As Worksheet
Public WsLastRow As Long
Public WsTemplateLastRow As Long
Public DestLastRow As String
Public FirstDateOfMonth As Long
Public LastDateOfMonth As LongCode principal :
Option Explicit
Sub StaffCheck()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
'Define month of reference
RefMonth = InputBox("Please enter the month of reference. If you're doing a monthly check to update the list, please click OK", "Month selection", Month(Date))
If RefMonth = "" Then
MsgBox "Nothing has been entered. Macro aboarded"
Exit Sub
End If
Define_Names
Set wb = thisworkbook
Set ws = wb.Worksheets("Staff check")
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
End If
'Open source files
Set WbTemplate = Workbooks.Open(WbTemplateNDFPath)
Set WsTemplate = WbTemplate.Sheets(WsTemplateNDFName)
WbTemplate.Unprotect "NDF"
With WsTemplate
.Visible = True
.Unprotect "NDF"
End With
Set WbStaff = Workbooks.Open(WbStaffPath)
Set WsStaff = WbStaff.Sheets(WsStaffName)
WsStaff.Select
Cells.EntireColumn.Hidden = False
Cells.EntireRow.Hidden = False
'Paste staff from last NDF template
ws.Activate
WsLastRow = ws.Range("G" & Rows.Count).End(xlUp).Row
ws.Range("G15:P" & WsLastRow).Delete
WsTemplate.Activate
WsTemplateLastRow = Range("B" & Rows.Count).End(xlUp).Row
WsTemplate.Range("B4:I" & WsTemplateLastRow).Copy
ws.Range("G15").PasteSpecial xlPasteAll
wb.Worksheets.Add().Name = "Destination"
Set WsDest = wb.Sheets("Destination")
'Check departure
FirstDateOfMonth = DateSerial(Year(Date), RefMonth, 1)
LastDateOfMonth = DateSerial(Year(Date), RefMonth + 1, 0)
With WsStaff
.Range("L_All").AutoFilter Field:=27, Criteria1:=">=" & LastDateOfMonth, Operator:=xlOr, Criteria2:="="
.Range("L_All").AutoFilter 16, Array("Entreprise 1", "Entreprise 2", "Entreprise 3"), xlFilterValues
.Range("L_All").AutoFilter 2, "<900000", xlFilterValues
.Range("L_All").SpecialCells(xlCellTypeVisible).Copy
End With
'Copy of current employees in the Destination Worksheet
wb.Activate
WsDest.Range("A1").PasteSpecial xlPasteValues
'****** MACRO ERROR *******
WsStaff.Range("A12:AD12").Copy
'****** MACRO ERROR ******
WsDest.Range("A1").PasteSpecial xlPasteValues
DestLastRow = WsDest.Range("G" & Rows.Count).End(xlUp).Row
'Match between NDF Template data and Staff DB data
ws.Activate
Range("O16").FormulaArray = "=IFERROR(INDEX(Destination!$M$2:$M$352,MATCH(1,(Destination!$C$2:$C$352=H16)*(Destination!$D$2:$D$352=I16),0)),""Not found"")"
Range("O16").Copy
Range("O17:O" & WsLastRow).PasteSpecial
Application.DisplayAlerts = False
WbStaff.Saved = True
WbStaff.Close
Application.DisplayAlerts = True
Calculate
Range("O15:O" & WsLastRow).Copy
Range("O15:O" & WsLastRow).PasteSpecial xlPasteValues
With ws.Range("P16:P" & WsLastRow)
.FormulaLocal = "=SI(O16=L16;""CC is up to date"";SI(O16=""Not found"";""Seems like this person left!"";""Update CC with the actualised one""))"
.Copy
.PasteSpecial xlPasteValues
End With
ws.Range("M14:N" & WsLastRow).Copy
ws.Range("O14:P" & WsLastRow).PasteSpecial xlPasteFormats
ws.Range("P14").AutoFilter 10, "<>CC is up to date", xlAnd, "<>="
Application.DisplayAlerts = False
WsDest.Delete
WbTemplate.Saved = True
WbTemplate.Close
ws.Range("H12").Value = "User database as of " & MonthName(RefMonth) & " " & Year(Date)
Range("L_Lastupdate").Value = "Last update : " & Format(Now, "dd/mm/yyyy hh:mm")
Range("L_Lastupdate").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Staff check completed. Only changes are displayed, you can see the full list by unfiltering the cell P14"
End SubJe ne peux malheureusement pas fournir les fichiers qui sont assez sensibles ...
A noter qu'il semblerait que le problème vienne du fichier de staff WbStaff qui contient des macros qui se lancent au démarrage.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("YTD Moves (FU)").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
ActiveWindow.ScrollRow = ActiveCell.Row - 15
ActiveWindow.ScrollColumn = ActiveCell.Column
Range("L_Lastupdate").Value = "Last update : " & Format(Now, "dd/mm/yyyy hh:mm")
Range("L_Lastupdate_Name").Value = "by " & Environ("USERNAME")
End Sub
Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
End SubJ'ai refait entièrement la macro mais le problème est toujours là ...
Merci d'avance