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