Este fórum está sendo desativado

[dgomedeiros]

Boa tarde pessoal!!

Queria saber de você como faço um macro que copia os dados de uma seleção (a linha inteira ou células adjacentes a uma determinada célula) feita na Plan2 e cola estes dados na primeira célula vazia da Plan3. Antes de colar deve ser criado um enumerador de itens, mas este eu consigo fazer. Este macro será vinculado a um botão chamado "Adicionar" localizado na Plan2.

Objetivo da planilha: fazer uma busca de itens num banco de dados e ao selecionar um determinado item e clicar no botão "Adicionar" este item será copiado para uma nova planilha.

[dgomedeiros]

Por hora este aqui me resolveu. Quando alguém chegar a uma solução mais prática eu fecho o tópico.

Public Sub Adicionar()

Selection.Copy
Worksheets("Sheet3").Select
Linha = Range("A6000").End(xlUp).Row
If Range("A" & Linha).Value <> "" Then
Range("A" & Linha + 1).Value = Selection.Value
Else
Range("A" & Linha).Value = Selection.Value

End If
Worksheets("Sheet3").Paste
Selection.Insert Shift:=xlUp
Plan2.Select
End Sub

[babdallas]

Sub Copiar_Intervalo()
'Copia todas os dados da planilha 1 para a primeira célula vazia abaixo dos dados da planilha 2

Dim lin_ini As Long, col_ini As Long, col_fim As Long, lin_fim As Long
Dim lin_ini2 As Long, col_ini2 As Long, col_fim2 As Long, lin_fim2 As Long
Dim contador As Long

col_ini = 6 'Coluna inicial com dados da planilha1
lin_ini = 4 'Linha inicial de onde começam os dados da planilha 1
col_fim = Planilha1.Cells(lin_ini, Planilha1.Columns.Count).End(xlToLeft).Column 'Última coluna com dados da planilha1
lin_fim = Planilha1.Cells(Planilha1.Rows.Count, col_ini).End(xlUp).Row 'Última linha com dados da planilha1

col_ini2 = 1 'Coluna inicial com dados da planilha2
lin_ini2 = 2 'Linha inicial de onde começam os dados da planilha 2
col_fim2 = Planilha2.Cells(lin_ini2, Planilha2.Columns.Count).End(xlToLeft).Column 'Última lcoluna com dados da planilha2
lin_fim2 = Planilha2.Cells(Planilha2.Rows.Count, col_ini2).End(xlUp).Row 'Última linha com dados da planilha2

With Planilha1
.Range(.Cells(lin_ini, col_ini), .Cells(lin_fim, col_fim)).Copy _
Destination:=Planilha2.Cells(lin_fim2 + 1, col_ini2)
End With

End Sub

[dgomedeiros]

Segue abaixo como consegui resolver o que precisava e da forma que gostaria.

- Criar um novo Userform e adicionar o código abaixo:

Option Explicit
Private valor_pesquisado As String
_________________________________________________________

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim valor_lista As String
Dim selecao As String

selecao = ListBox1.ListIndex
valor_lista = ListBox1.List(selecao, 0)

frmAgenda.txtNome = valor_lista
frmAgenda.txtNome.SetFocus
frmAgenda.txtSetorCidade.SetFocus
frmAgenda.txtNome.SetFocus 'Coloca o cursor na caixa de texto Nome

Unload Me

End Sub
_________________________________________________________

Private Sub txtBuscar_Change()

valor_pesquisado = txtBuscar.Text
Call buscar_valores

End Sub
__________________________________________________

Private Sub frmBuscar_Initialize()

Call buscar_valores

End Sub
_________________________________________________________
Private Sub buscar_valores()

Dim guia As Worksheet
Dim linha As Integer
Dim coluna As Integer
Dim linhalistbox As Integer
Dim valor_celula As String
Set guia = ThisWorkbook.Worksheets(1)

linha = 2
coluna = 2
linhalistbox = 0

ListBox1.Clear

With guia
While .Cells(linha, coluna).Value <> Empty
valor_celula = .Cells(linha, coluna).Value

If UCase(Left(valor_celula, Len(valor_pesquisado))) = UCase(valor_pesquisado) Then

With frmBuscar.ListBox1
.AddItem
.List(linhalistbox, 0) = Sheets("Plan1").Cells(linha, 2)
linhalistbox = linhalistbox + 1
End With

End If
linha = linha + 1
Wend
End With

End Sub