VBA code with Excel on OneDrive

Hello everyone,

I have 26 identical files that I call A to Z and another one called 99. The A to Z files are shared with different users (26 total) on OneDrive and contain functioning VBA code.

The procedure for the A to Z files is that the user selects the file to open on OneDrive
Right-click
Open with their Excel
Modifies the data and validates

I tested it and it works

For the file 99, its purpose is to transfer a worksheet from the A to Z files to file 99. The A to Z files are all closed and located in the same directory as file 99, which is OneDrive/directory_name

The existing VBA code in file 99 works locally. Opening it with their Excel on OneDrive works, but the VBA crashes

Below is the code to transfer my data, with the crash point in bold/italic/underlined

Thank you for your help

Sub IMPORTATION()

' Procedure for consolidating multiple workbooks
'
Dim wbk As Workbook
Dim wshScr As Worksheet
Dim wshDst As Worksheet
Dim celDst As Range
Dim rng As Range
Dim chemin As String
Dim nomClasseur As String
Dim derLigne As Long

'Sheets("TRANS_CONSO").Select
Sheets("TRANS_CONSO").Activate
Range("B3:AK10000").ClearContents

' Stop screen refreshing
 Application.ScreenUpdating = False
 ' Set the destination sheet
 Set wshDst = ThisWorkbook.Worksheets("TRANS_CONSO")
 
 ' Reset the summary file for classifications
 With wshDst

 ' Define the destination cell for the data
 Set celDst = .Range("B3")
 End With
 
 ' Step 2: Loop through all files in the current folder
 chemin = ThisWorkbook.Path & "\"

' Name of the first workbook in the folder
  nomClasseur = Dir(chemin & "*.xlsm")

' Loop to open the workbooks in the folder
 Do While Len(nomClasseur) > 0
 If nomClasseur <> ThisWorkbook.Name Then ' except this consolidation workbook

 ' Open the workbook
 Set wbk = Workbooks.Open(chemin & nomClasseur, False)
 ' Define the JOUEURS worksheet
 On Error Resume Next
 Set wshScr = wbk.Worksheets("TRANSFERT")
 On Error GoTo 0
 ' Test existence of the sheet
 If Not wshScr Is Nothing Then
 With wshScr
 ' Number of the last line of data
 derLigne = .Cells(.Rows.Count, "B").End(xlUp).Row
 ' Replace formulas with their values (to break links)
 .UsedRange.Value = .UsedRange.Value
 ' Copy all data
 .Range("B3:AK" & derLigne).Copy celDst
 End With
 ' Define the next destination cell for the data
 Set celDst = celDst.Offset(derLigne - 2)
 
 End If
 ' Close the data workbook without saving changes
 wbk.Close False
 End If
 ' Name the next workbook
 nomClasseur = Dir
 
 Loop
 ' Sort by club + name surname
 
 ActiveWorkbook.Worksheets("TRANS_CONSO").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("TRANS_CONSO").Sort.SortFields.Add Key:=Range( _
 "D3:D10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 ActiveWorkbook.Worksheets("TRANS_CONSO").Sort.SortFields.Add Key:=Range( _
 "F3:F10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("TRANS_CONSO").Sort
 .SetRange Range("B3:AK10000")
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 ' Message
 Call TRANSFERT
 
 MsgBox " Import and transfer without duplicates completed "

End Sub