Impossible d'ouvrir le fichier car son Extension ou son format

Bonjour,

J'ai un code qui créé un fichier en fonction du résulat d'une cellule.
Si quelque chose se trouve dans ma cellule alors il créé le fichier portant ce même nom.
Les chemins se situent sur Sharepoint.

Mon problème est que le fichier se créé bien, mais au moment de l'ouvrir il me dit
"Impossible d'ouvrir le fichier car son Extension ou son format n'est pas valide."

Le fichier est présent dans le répertoire mais est impossible à ouvrir même manuellement.

Après plusieurs recherche sur internet, le problème viendrait de "SaveAs" qui pourrait
endommager les fichiers. Cependant je ne sais pas comment faire autrement.

J'ai déjà exécuté ce code, parfois il copie sans endommager et d'autre fois il me fait cette erreur.

sub Crea()

Dim cheminMo, cheminCree as string
Dim Verif as Boolean

cheminMo = "https://..." 'Chemin sharepoint
cheminCree = "https://..." 'Chemin sharepoint
cheminCree = Replace(Replace(CheminCree, "https:", ""), "/", "\")


Sheets("Co").Select

For Each Cell In Sheets("Co").UsedRange.Columns("A").Cells
        
        If Cell.Row > 1 Then

  Num = Range("A" & Cell.Row).Value
  Sem = Range("K" & Cell.Row).Value

 File = Sem & ".xlsx"

Sheets("Part").select

For Each Ligne In Sheets("Part").UsedRange.Columns("A").Cells

Tld = Name & "_OK" & Num & ".xlsx"

If Tld = Ligne.value then

 Verif = true

 Tld = ""
 exit for
else
 Verif = False
end if
next


If Verif = False then

Workbooks.Open (cheminMo & File)

Application.DisplayAlerts = False

 ActiveWorkbook.SaveCopyAs cheminCree & Tld
 Workbooks.Open (cheminCree & Tld)

Range("A1").value = Num

end if

end if

Sheets("Co").Select

next 

end sub

Merci pour votre aide.