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