Code VBA avec son Excel sur Onedrive

Bonjour, à tous,

J'ai 26 fichiers identiques que j'appel A à Z et un autre 99. Les fichiers A à Z sont partagés avec des utilisateurs tous différents soit (26) sur Onedrive et contiennent du code VBA est fonctionne.

La manip pour les fichiers A à Z est que l'utilisateur sélectionne le fichier à ouvrir sur Onedrive
Click droit
Ouvrir avec Son Excel
Modifie les données et les valide

J'ai testé et sa fonctionne


Pour le fichier 99, celui-ci a pour vocation de transférer une feuille de calcul des fichiers A à Z vers le fichier 99. Les fichiers A à Z sont tous fermés et se trouvent tous dans le même répertoire y compris le fichier 99 soit Onedrive/nom_de_repertoire

Le code VBA existant dans le fichier 99 fonctionne en local. L'ouverture avec son Excel sur Onedrive fonctionne, en revanche, le VBA plante

Ci-dessous, le code pour transférer mes données et en gras/italique/souligné le point de plantage

Merci pour votre aide

Sub IMPORTATION()

' Procédure permettant la consolidation de plusieurs classeurs
'
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


  ' Arrêt du raffraichissement de l'écran
  Application.ScreenUpdating = False
  ' Définition de la feuille de destination
    Set wshDst = ThisWorkbook.Worksheets("TRANS_CONSO")
  
  ' Réinitialisation du fichier de synthèse des classements
  With wshDst

    ' Définition de la cellule de destination des données
    Set celDst = .Range("B3")
  End With
    
  ' Etape n° 2 : Parcourir tous les fichiers du dossier courant
  chemin = ThisWorkbook.Path & "\"


  ' Nom du premier classeur dans le dossier
  nomClasseur = Dir(chemin & "*.xlsm")
 


 ' Boucle pour ouvrir les classeurs du dossier
  Do While Len(nomClasseur) > 0
    If nomClasseur <> ThisWorkbook.Name Then ' sauf ce classeur de consolidation

      ' Ouverture du classeur
      Set wbk = Workbooks.Open(chemin & nomClasseur, False)
          ' Définition de la feuille de calcul JOUEURS
      On Error Resume Next
      Set wshScr = wbk.Worksheets("TRANSFERT")
      On Error GoTo 0
      ' Test existance de la feuille
      If Not wshScr Is Nothing Then
        With wshScr
          ' Numéro de le derniere ligne de données
          derLigne = .Cells(.Rows.Count, "B").End(xlUp).Row
          ' Remplacement des formule par leur valeurs (pour rompre les liaisons)
          .UsedRange.Value = .UsedRange.Value
          ' Copie de toutes les données
          .Range("B3:AK" & derLigne).Copy celDst
        End With
        ' Définition de la prochaine cellule de destination des données
        Set celDst = celDst.Offset(derLigne - 2)
   
      End If
      ' Fermeture du classeur de données sans le modifier
      wbk.Close False
      End If
      ' Nom du prochain classeur
      nomClasseur = Dir
    
  Loop
  'classement selon club +nom prénom
  
    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 " Importation et transfert sans doublon terminés "

End Sub