Visual Basic Copiar arquivo para outra pastas

[Solraceu]

Bom dia, Geral.

Estou com problema para realizar a copiar de um arquivo de uma determinada pasta para outra. Ocorre um erro na programação.

 

Poderiam me ajudar abaixo a programação.

 

Sub CopiarArquivo()

Dim NomeSheet As String
Dim Arq As String
Dim DestinoPasta, OrgiemPasta As String

NomeSheet = ActiveSheet.Name
 
OrigemPasta = "C:\Users\ativa\Desktop\GRANO NF\XML 082017a082018\"
DestinoPasta = "C:\Users\ativa\Desktop\GRANO NF\xml GRANO\" & NomeSheet & "\"
 

If Dir(DestinoPasta, vbDirectory) = "" Then
 
MkDir DestinoPasta
 
 
End If

Range("D1").Select

Do Until ActiveCell.Offset(1, 0) = Empty
    
    ActiveCell.Offset(1, 0).Select
    Arq = ActiveCell.Value
    
    FileCopy OrigemPasta & Arq & "*.xml", DestinoPasta & Arq & "*.xml"
    

Loop

End Sub