Ir ao conteúdo
  • Cadastre-se

Procurar informação e copiar em outra aba - se não duplicado


Ir à solução Resolvido por Visitante,

Posts recomendados

Boa tarde Pessoal, tudo bem?

 

Estou aqui, quebrando minha cabeça, pois não consigo fazer rotina de Loop para Procurar uma informação em uma aba e adicionar em outra.

 

Gostaria que vocês pudessem me ajudar, a propósito, preciso:

 

A tabela "Data" jogo informações que sempre se atualizam;

A tabela "Disputas" copiam informações da tabela Data, porém, atualizo a "Data" todos os dias, mas não posso perder informações do que já coloquei na tabela Disputas (EX.: Acompanhamento e ect). O que preciso é: Ao adicionar o conteúdo na aba "Data", o botão Atualizar iria procurar na aba "Disputas" (Ambas na coluna A) se a informação já estava lá, se estivesse ignoraria, mas se não tivesse copiar algumas da mesma linha e de colunas diferentes da aba "Data" para aba "Disputas".

 

 

O codigo que tinha feito mas nãodeu certo

 

Sub Localizar()
Dim c As Range, LR As Long


LR = Sheets("Disputas").Cells(Rows.Count, 1).End(xlUp).Row
Do
  Set c = Sheets("Disputas").Range("A2:A" & LR).Find(Sheets("Data").Range("A:A").Value, LookIn:=xlValues, LookAt:=xlWhole)
   If Not c Is Nothing Then
    With Sheets("Disputas")
     c.Offset(0, 1).Value = Sheets("Data").Cells(x, "A")
     c.Offset(0, 2).Value = Sheets("Data").Cells(x, "B")
     c.Offset(0, 3).Value = Sheets("Data").Cells(x, "N")
     c.Offset(0, 4).Value = Sheets("Data").Cells(x, "D")
     c.Offset(0, 5).Value = Sheets("Data").Cells(x, "I")
     c.Offset(0, 6).Value = Sheets("Data").Cells(x, "J")
     End With
   End If
Loop
End Sub
 

Disputas Oficial_V01.xls

Link para o comentário
Compartilhar em outros sites

  • Solução

Salve Itatiba !   :tw_glasses:

Veja se ajuda.

Sub Replicadados()
 Dim LRo As Long, LRd As Long, ND As Range, c As Range
  LRo = Cells(Rows.Count, 1).End(3).Row: If LRo < 7 Then Exit Sub
  For Each ND In Range("A7:A" & LRo)
   With Sheets("Disputas")
    LRd = .Cells(Rows.Count, 1).End(xlUp).Row
    Set c = .Range("A2:A" & LRd).Find(ND.Value, Lookat:=xlWhole)
    If c Is Nothing Then
     .Cells(LRd + 1, 1) = Cells(ND.Row, "A")
     .Cells(LRd + 1, 2) = Cells(ND.Row, "B")
     .Cells(LRd + 1, 3) = Cells(ND.Row, "N")
     .Cells(LRd + 1, 4) = Cells(ND.Row, "D")
     .Cells(LRd + 1, 5) = Cells(ND.Row, "I")
     .Cells(LRd + 1, 6) = Cells(ND.Row, "J")
    End If
   End With
  Next ND
End Sub

 

Link para o comentário
Compartilhar em outros sites

@osvaldomp Você sempre arrasa, dá até vergonha assim! kkk

adicionado 1 minuto depois

Acho que dá pra usar um esquema parecido para resolver aquele meu outro problema, né? Para cada linha em uma aba, ele solta umas informações fixas preenchidas de acordo com a linha.

 

Estou certa disso?

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...