Transfer data from one workbook to another in different folders via vba.

[MS_1977]

I'm having trouble with a vba code, to copy data from one Workbook to another, in different folders. Would there be any way to accomplish this process via code?

 

[mumps]

In the "Programação de Cargas D+1.xlsb" workbook, the "BD-Planejado" sheet tab name has a space at the end. Please delete that extra space in the sheet name and re-save the file and close it. Then try this macro:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lRow As Long, srcWS As Worksheet, desWB As Workbook, desWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Consolidado_De_Cargas")
    Set desWB = Workbooks.Open("\\Loja5470\pac$\Delivery\TRANSPORTE ESTRATÉGICO\38 - Planejamento Logistico\Roteirização\Programação de Cargas D+1.xlsb")
    Set desWS = Sheets("BD-Planejado")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lRow = desWS.Columns(2).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    With srcWS
        Union(.Range("C3:C" & LastRow - 3), .Range("B3:B" & LastRow - 3), .Range("H3:H" & LastRow - 3), .Range("AR3:AR" & LastRow - 3), .Range("U3:U" & LastRow - 3)).Copy
        desWS.Range("B" & lRow).PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[MS_1977]

Na pasta de trabalho "Programação de Cargas D + 1.xlsb", o nome da guia da planilha "BD-Planejado" tem um espaço no final. Exclua esse espaço extra no nome da planilha, salve novamente o arquivo e feche-o. Em seguida, tente esta macro:
[CODE = vba]
Sub CopyData ()
Application.ScreenUpdating = False
Dim LastRow As Long, lRow As Long, srcWS As Worksheet, desWB As Workbook, desWS As Worksheet
Set srcWS = ThisWorkbook.Sheets ("Consolidado_De_Cargas")
Set desWB = Workbooks.Open ("\\ Loja5470 \ pac $ \ Delivery \ TRANSPORTE ESTRATÉGICO \ 38 - Planejamento Logistico \ Roteirização \ Programação de Cargas D + 1.xlsb")
Definir desWS = Folhas ("BD-Planejado")
LastRow = srcWS.Cells.Find ("*", SearchOrder: = xlByRows, SearchDirection: = xlPrevious) .Row
lRow = desWS.Columns (2) .Find ("*", SearchOrder: = xlByRows, SearchDirection: = xlPrevious) .Row + 1
Com srcWS
Union (.Range ("C3: C" & LastRow - 3), .Range ("B3: B" & LastRow - 3), .Range ("H3: H" & LastRow - 3), .Range ("AR3: AR "& LastRow - 3), .Range (" U3: U "& LastRow - 3)). Copiar
desWS.Range ("B" & lRow) .PasteSpecial xlPasteValues
Terminar com
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/CÓDIGO]

 

[MS_1977]

Mumps, Sensational It worked perfectly my friend, thank you very much for your support and clear weather.

 

[mumps]

You are very welcome.