Copier classeur

Function DialogBox(Optional Root As String, Optional DialogTitle As String = "Selection du repertoire de destination...", Optional DialogType As MsoFileDialogType = msoFileDialogFolderPicker) As String
        With Application.FileDialog(DialogType)
            .AllowMultiSelect = False
            .Title = DialogTitle
            .InitialFileName = Root
            If .Show = -1 Then DialogBox = .SelectedItems(1)
        End With
End Function
Function CopierFichier(ByVal Fichier As String, ByVal RepertoireSource As String, ByVal RepertoireDeDestination As String, Optional OverWrite As Boolean = False)
    Dim fs As Object, f As Object, reponse As String
    
    If Not Right$(RepertoireSource, 1) = Application.PathSeparator Then RepertoireSource = RepertoireSource & Application.PathSeparator
    If Not Right$(RepertoireDeDestination, 1) = Application.PathSeparator Then RepertoireDeDestination = RepertoireDeDestination & Application.PathSeparator

    Set fs = CreateObject("Scripting.FileSystemObject")
    If OverWrite = True Then
        Set f = fs.getfile(RepertoireDeDestination & Fichier)
        If f.Attributes Mod 2 = 1 Then
            reponse = MsgBox("Le fichier '" & Fichier & "' du repertoire '" & RepertoireDeDestination & "' est en lecture seul! " & vbCrLf & _
                    "Voulez-vous quand même ecraser le fichier existant ?", vbExclamation + vbYesNo)
            If reponse = vbYes Then
                f.Attributes = f.Attributes - 1
            Else
                Exit Function
            End If
        End If
    End If
    fs.Copyfile RepertoireSource & Fichier, RepertoireDeDestination, OverWrite
End Function
Sub test()
    Dim MonFichier As String, NewRep As String, RepSource As String, reponse As VbMsgBoxResult

    MonFichier = DialogBox("C:\", "Selection du fichier à Copié...", msoFileDialogFilePicker)
    If MonFichier = "" Then Exit Sub
    RepSource = Replace(MonFichier, Dir(MonFichier), "")
    MonFichier = Dir(MonFichier)
    NewRep = DialogBox(RepSource)
    If NewRep = "" Then
        Exit Sub
    Else
     NewRep = NewRep & Application.PathSeparator
    End If
    If Not Dir(NewRep & Dir(MonFichier)) = "" Then
        reponse = MsgBox("Le fichier '" & MonFichier & "' existe déjà, dans le repertoire '" & _
                    NewRep & "' !" & vbCrLf & "Voulez-vous écraser le fichier '" & Dir(MonFichier) _
                    & "' ?", vbExclamation + vbYesNo)
        If reponse = vbYes Then
        
            CopierFichier MonFichier, RepSource, NewRep, True
        Else
            Exit Sub
        End If
    Else
        CopierFichier MonFichier, RepSource, NewRep
    End If
End Sub