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").Copy

Ci-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 Sub

Dé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 Long

Code 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 Sub

Je 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 Sub

J'ai refait entièrement la macro mais le problème est toujours là ...

Merci d'avance

Rechercher des sujets similaires à "classeur mode l1c1 2eme execution macro"