Este fórum está sendo desativado

[toglima]

Pessoal, boa noite!
Fiz um pequeno dash para acompanhamento de alguns itens que ficam expostos em uma lista, que hoje somam 120 linhas. Tenho algumas macros nele para automatização etc. No entanto, empaquei num ponto e não consigo sair.
Nas linhas que estão no front tenho os nomes dos itens, mas preciso de uma funcionalidade do seguinte modo: ao clicar sobre o nome do item (célula B3), preciso pegar o dado da célula A3 e copiar para outra célula numa outra planilha que servirá de base para detalhar cada item, como num procv (note que preciso fazer isso variável para que em cada linha que eu clicar, ele me traga o dado da coluna A e da linha correspondente que eu estiver clicando e cole na outra planilha para usar como índice do proc).
Os itens são variados, dependendo do filtro que eu fizer. Alguém pode me ajudar?
Obriagado.

[alexandrevba]

Bom dia!!

Veja se ajuda

Código: Selecionar todos

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lr As Long
  If Not Intersect(Target, Columns("B")) Is Nothing Then
    Cancel = True
    lr = WorksheetFunction.Max(2, Sheets("Plan2").Range("A" & Rows.Count).End(xlUp).Row + 1)
    If Target.Row > 1 And Len(Target.Value) Then Worksheets("Plan2").Range("A" & lr) = Target.Value
    Worksheets("Plan2").Activate
  End If
End Sub

o código deve ser posto dentro da módulo da guia desejada, troque a guia Plan2, conforme sua necessidade, assim como a coluna cujo os dados serão depositados.

Att

[toglima]

Funcionou perfeitamente, muito obrigado mesmo!
Só mais uma dúvida: se eu quiser que ao clicar apenas uma vez ele pegue o conteúdo da célula ao lado dela (por exemplo, clico uma vez na célula B3 e quero que ela pegue o conteúdo da A3 (mesma linha) e cole em algum lugar como está fazendo hoje, altero qual parte do código?

Obrigado de novo!!!

[alexandrevba]

Bomdia!!

Desculpe, eu esqueci dessa parte
Use essa linha

Código: Selecionar todos

Target.Offset(0, -1).Value

Fica assim.

Código: Selecionar todos

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lr As Long
  If Not Intersect(Target, Columns("B")) Is Nothing Then
    Cancel = True
    lr = WorksheetFunction.Max(2, Sheets("Plan2").Range("A" & Rows.Count).End(xlUp).Row + 1)
    If Target.Row > 1 And Len(Target.Value) Then Worksheets("Plan2").Range("A" & lr) = Target.Offset(0, -1).Value
    Worksheets("Plan2").Activate 'Caso não queira ir até a outra guia comente essa linha
  End If
End Sub

Por favor, click em Obrigado!!
Att

[toglima]

Obrigado mais uma vez.