Este fórum está sendo desativado

[piasserpa]

Queria uma macro para copiar valores de umas células quando o valor de uma célula é igual ao valor de outra célula e colar valor noutras células. Ex: se o valor da célula A1 for = ao valor da célula H30 então copia os valores das células C22; C23; C24; C25; C26; C27 e cola valores nas células H31; H32; H33; H34; H35; H36. se o valor da célula A1 for = ao valor da célula I30 então copia os valores das células C22; C23; C24; C25; C26; C27 e cola valores nas células I31; I32; I33; I34; I35; I36. A1 for = ao valor da célula J30 então copia os valores das células C22; C23; C24; C25; C26; C27 e cola valores nas células J31; J32; J33; J34; J35; J36 e assim por diante coluna após coluna.

Ex: encontra o valor da célula A1 na célula H30, então copia os valores das células C22; C23; C24;
C25; C26; C27 e cola nas células H31; H32; H33; H34; H35; H36. Se o valor da célula A1 for encontrado na célula K30 então
cola nas células K31; K32; K33; K34; K35; K36

As células do exemplo são as que estou usando na planilha.

Obrigado.

[osvaldomp]

... e assim por diante coluna após coluna.
Até qual coluna você quer fazer a busca ?

Ex: encontra o valor da célula A1 na célula H30, .... Se o valor da célula A1 for encontrado na célula K30 ...
O valor de A1 poderá se repetir em H30, I30, J30, ... ou estará só em uma célula, em K30 por exemplo ?

[piasserpa]

Olá osvaldomp,

A procura começa na coluna D (célula D30) e termina na coluna BD (célula BD30).

O valor das células não de repete, só existe numa célula.

Obrigado

[osvaldomp]

Veja se atende. Os códigos abaixo podem ser utilizados isolados ou em conjunto.

o código abaixo precisa do disparo direto do usuário (via atalho de teclado, via botão/figura ou via Alt+F8); instale uma cópia em um módulo comum

Código: Selecionar todos

Sub ReplicaDados()
 Dim k As Long
  For k = 4 To 56
   If Cells(30, k) = [A1] Then Cells(31, k).Resize(6).Value = [C22:C27].Value: Exit Sub
  Next k
End Sub

#
#
o código abaixo será disparado indiretamente após o usuário inserir manualmente um conteúdo em A1; instale uma cópia no módulo da planilha de interesse

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim k As Long
  If Target.Address <> "$A$1" Then Exit Sub
  If Target.Value = "" Then Exit Sub
  For k = 4 To 56
   If Cells(30, k) = [A1] Then Cells(31, k).Resize(6).Value = [C22:C27].Value: Exit Sub
  Next k
End Sub

[piasserpa]

Boa tarde Osvaldo,

A primeira funciona na perfeição, muito obrigado. Nem experimentei a segunda.