Microsoft 365 Couper Coller Fichiers en VBA

Option Explicit
Sub testmove()
    Dim DossierSource As String
    Dim DossierDestination As String
    Dim Fichier As String
    Dim Fso As Object, Ext As Variant

    ' Spécifiez les dossiers  directement ici
    DossierSource = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\" ' Modifiez cela avec votre chemin d'accès source
    DossierDestination = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\Exploitation données\" ' Modifiez cela avec votre chemin d'accès destination
  
    Set Fso = CreateObject("Scripting.FileSystemObject")
        If Fso.FolderExists(DossierSource) _
        And Fso.FolderExists(DossierDestination) Then
            On Error Resume Next ' Erreur Si pas de fichier avec l'extension
                For Each Ext In Array("*.docx", "*.txt")
                    Fso.DeleteFile DossierDestination & Ext
                    Fso.MoveFile DossierSource & Ext, DossierDestination
                Next
            On Error GoTo 0
            MsgBox "Les fichiers trouvés ont été coupés/collés avec succès."
        End If
    Set Fso = Nothing
   
End Sub

Sub cctest1()

    Dim DossierSource As String
    Dim DossierDestination As String
    Dim Fichier As String

    ' Spécifiez le dossier source directement ici
    DossierSource = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\"    ' Modifiez cela avec votre chemin d'accès source

    ' Spécifiez le dossier destination directement ici
    DossierDestination = "C:\Users\PXC610\OneDrive - SUEZ\Bon réception Fameck Teams\Exploitation données\"    ' Modifiez cela avec votre chemin d'accès destination

    ' Vérifier si les dossiers se terminent par un backslash (\)
    If Right(DossierSource, 1) <> "\" Then
        DossierSource = DossierSource & "\"
    End If

    If Right(DossierDestination, 1) <> "\" Then
        DossierDestination = DossierDestination & "\"
    End If

    ' Boucle à travers tous les fichiers Word (docx) dans le dossier source
    Fichier = Dir(DossierSource & "*.docx")
    Do While Fichier <> ""
        If Fichier <> ThisWorkbook.Name Then
            Kill DossierDestination & Fichier
            DoEvents
            ' Couper/coller le fichier Word dans le dossier destination
            Name DossierSource & Fichier As DossierDestination & Fichier
        End If
        Fichier = Dir
    Loop
End Sub