Como acessar pasta nas nuvens/HD network de outros computadores em redes diferentes.

Question

Bom dia.

Tenho escritorio das fabricas espalhadas em locais diferentes como mostra a figura abaixo, onde cada fabrica tem seus cadastro de funcionarios e gostaria de agrupar todos os funcionarios das unidades fabris em um arquivo de uma unica fabrica, por exemplo na Fabrica A, depois fazer gerar um DashBoard para que a Gerencia, em outro local, possa acessar a planilha dessa DashBoard.

O que estou imaginado e que qdo tiver alteracao nos dados cadastrais de cada fabrica, pudesse acessar o OneDrive da Fabrica A para transferir as alteracoes filtrando por fabrica, deletando e colando novos dados. Cada planilha das fabricas teriam um botao de tranferencia para transferir as atualizacoes, ou seja de uma Fabrica remota, filtra a tabela do OneDrive da Fabrica A na coluna Fabrica com criterio da unidade fabril a ser alterada, deleta e cola novos dados.

Consigo fazer o acesso do OneDrive da fabrica A com o One Drive do mesmo computador, mas como fazer o caminho para outras fabricas acessarem o OneDrive da fabrica A?, E possivel fazer?

Desde ja agradeco um retorno.

Tadao

Sistema

Planilha com Tabela da Fabrica A

Planilha com Tabela de Dados agrupados de todas as Fabricas na Nuvem da Fabrica A

Codigo que usei para Tranferir dados para o One Drive. Como mudar o caminho para acessar One Drive de outro sistema?

Sub Tranferencia()
Dim wbC As Workbook: Set wbC = ThisWorkbook
Dim wsx As Worksheet: Set wsx = wbC.Worksheets("Aux")
Dim wsC As Worksheet: Set wsC = wbC.Worksheets("Cadastro")
Dim wbN As Workbook
Dim wsN As Worksheet
Dim buf As String
Dim BookPath As String
Dim myCriterio As String
Application.ScreenUpdating = False

'coloca na variavel "BookPath", o endereco da Pasta da nuvem com extencao,
'armazenado no intervalo "Caminho"
BookPath = wsx.Range("Caminho").Value
myCriterio = wsx.Range("Criterio")

'coloca na variavel "buf", o nome da Pasta com extencao procurada
buf = Dir(BookPath)
'se a variavel "buf" for "", mensagem...
If buf = "" Then
              MsgBox "Pasta de Trabalho => " & Range("Caminho") & _
                            "  ....nao encontrada!", , "Mensagem de Erro"
              Exit Sub
End If
        
Application.DisplayAlerts = False

'se a Pasta estiver fechada abre
On Error Resume Next
Open Range("Caminho") For Append As #1
Close #1
If Err.Number > 0 Then
       'pasta ja aberta, define wbN como Pasta da Nuvem
        Set wbN = Workbooks(buf)
        Set wsN = wbN.Worksheets("Cadastro")
Else
         'abre a pasta fechada,  e define como wbN a Pasta da Nuvem
        Set wbN = Workbooks.Open(BookPath)
        Set wsN = wbN.Worksheets("Cadastro")
End If
'reseta o On Error
On Error GoTo 0
'filtra a coluna da unidade fabril
With wsN.ListObjects(1)
        .ShowAutoFilter = False
        .Range.AutoFilter _
                field:=.ListColumns("Fabrica").Index, _
                Criteria1:=myCriterio
        On Error Resume Next
        'deleta os registros filtrados
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
        On Error GoTo 0
        .ShowAutoFilter = False
        'copia  e cola os novos dados
        wsC.ListObjects(1).DataBodyRange.Copy
        .ListColumns(1).Range(2, 1).Offset(.ListRows.Count).PasteSpecial xlPasteValues
End With
wbN.Activate
Application.ScreenUpdating = True
MsgBox "Transferido com Sucesso", vbOKOnly, "Verificar se os Dados Foram Transferidos"
wbC.Activate

wsC.Activate
Application.CutCopyMode = False
Application.DisplayAlerts = True


End Sub