Importação evitando duplicidades Excel VBA

Boa tarde!

Pessoal,

É seguinte eu tenho duas planilhas para controle de tarefas, uma utilizada pelo Gestor (Consolidada) e outra pelo colaborador (cada um tem a sua). A idéia é o Gestor carregar as informações da planilha dos colaboradores diariamente para a planilha Consolidada e  se um registro já existir apenas alterar os campos e não importar para evitar duplicidade.
Segue o meu código, nesse caso, está carregando tudo sem validação, sem filtros.

Código:

Public Sub Consolidar()

Dim lin01, lin02, lin03 As Integer
Dim ArqColobaborador As String

Application.ScreenUpdating = False


lin01 = 3
lin03 = 2
Do Until Sheets("Painel").Cells(lin01, 3).Value = Empty
   Arqcolaborador = Sheets("Painel").Cells(lin01, 3).Value
   Workbooks.Open (ThisWorkbook.Path & "\Colaboradores\" & Arqcolaborador & ".xlsx")
   lin02 = 2

   Do Until Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 1).Value = Empty
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 1).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 1).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 2).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 2).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 3).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 3).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 4).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 4).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 5).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 5).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 6).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 6).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 7).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 7).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 8).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 8).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 9).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 9).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 10).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 10).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 11).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 11).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 12).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 12).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 13).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 13).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 14).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 14).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 15).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 15).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 16).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 16).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 17).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 17).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 18).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 18).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 19).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 19).Value
       ThisWorkbook.Sheets("Demandas").Cells(lin03, 20).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 20).Value
       
      lin03 = lin03 + 1
      lin02 = lin02 + 1
     
   Loop
   
   
   Workbooks(Arqcolaborador).Close (False)
   lin01 = lin01 + 1

Loop
End Sub

   
Se puderem me ajudar, eu agradeço

bjs

Janette boa tarde,

Apesar do fórum ser relacionado às duvida do Access, vou tentar te ajudar.

Provavelmente, é necessário fazer um PROCV (Vlookup) na planilha do Consolidado e, se achar os dados da planilha do colaborador, edita a linha, senão adiciona a linha.

Segue um exemplo em VBA:

Código:



Sub vbaProcvTodosValoresComErro()
 
    ultLinha = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    Dim codigo_produto As Integer
 
   
    For inicio = 2 To ultLinha
       
        codigo_produto = Cells(inicio, 1).Value
 
        resultado_procv = Application.VLookup(codigo_produto, Workbooks("Pasta1").Sheets("Planilha2").Range("A:B"), 2, False)
        If IsError(resultado_procv) Then
            Cells(inicio, 3).Value = "valor não encontrado"
        Else
            Cells(inicio, 3).Value = resultado_procv
        End If
        Next inicio
 
End Sub





Fonte: excelpraontem.com.br/procv-vba/

Espero ter ajudado

Oi Alexandre,

Obrigada pela resposta!

Mas como eu adapto esse código ao meu?

bjs

ola

Parece-me que o mais fácil é você copiar todo o arquivo do colaborador para o arquivo consolidado e depois remover as linhas duplicadas.
cria um botão na planilha Consolidado com o nome atualizar e atribui ao mesmo o seguinte código(macro e função):

Código:

Function rngUsado(ws As Worksheet) As Range
'determina o nª de linhas da Folha
 With ws
   Set rngUsado = .Range("A1:" & _
    .UsedRange(.UsedRange.Cells.Count).Address)
 End With
End Function

Public Sub copiar()

    Dim wb As Workbook
   Dim wsTodos As Worksheet
   

Application.DisplayAlerts = False
     
           Set wb = Workbooks.Open (ThisWorkbook.Path & "\Colaboradores\" & Arqcolaborador & ".xlsx")
     
       rngUsado(wb.Sheets(1)).Copy Destination:=wsTodos.Range("A" & _
      rngUsado(wsTodos).Rows.Count + 1)
     wb.Close
 
Application.DisplayAlerts = True

 'MsgBox "Actualização  concluída com sucesso!!! "
End Sub

Depois precisa criar uma nova macro para remover os duplicados para isso preciso saber qual ou quais os campos(celulas) que são sempre iguais em cada linha (pode gravar com o gravador automatico)
se o nome da macro for (removeduplicados) então no final da macro acima  antes do Msgbox coloca mais uma linha com o seguinte:
call removeduplicados.

se não conseguir criar a macro para remover os duplicados "apite".

se tiver varios colaboradores vai ter de fazer este processo tantas vezes quanto o nª de colaboradores pode depois usar um ciclo For