Saberexcel - o Site das Macros

Esta macro do Aplicativo Microsoft Excel VBA, contém uma macro que copia os dados de uma determinada planilha para outra planilha, isto é, copia os dados da Planilha ("Lista") para Planilha ("Resumo"). Observem como foi "Setado" (Set) as variáveis com os nomes das folhas de planilhas e os nomes dos intervalos range (para procura da área usada). e abra outra planilha chamada "Resumo". Então:
Abra duas planilhas: "Lista" e "Resumo" a Planilha "Resumo" vai receber o relatório, isto o ítem que voce selecionar e executar a macro.

Option Explicit

Sub Artigo_para_resumo()
'Excel VBA Estudos <Escola de Informática>
Dim VlorDados As Variant
Dim wsPlan As Worksheet, wsResumo As Worksheet
Dim rnPlan As Range, rnResumo As Range, RnDados As Range
Dim lnLinhaAtiva As Long, lnProximaLinha As Long

Set wsPlan = ThisWorkbook.Worksheets("Lista")
Set wsResumo = ThisWorkbook.Worksheets("Resumo")
Set rnPlan = wsPlan.Range("A2", Range("C65536").End(xlUp))

'Verificação de que a célula activa se encontra na barra de espaço
'onde estão as celulas com os dados para serem transferidos.
If Intersect(ActiveCell, rnPlan) Is Nothing Then
MsgBox "Você deve selecionar um item no lista do estoque.", _
vbInformation, "Fora da Area!! <Saberexcel.com>"
Exit Sub
End If

'Recuperando na célula activa número da linha
lnLinhaAtiva = ActiveCell.Row
Set RnDados = wsPlan.Range("A" & lnLinhaAtiva & ":C" & lnLinhaAtiva)

'são os valores das celulas(range)
VlorDados = RnDados.Value

'Identifica a próxima linha vazia na zona da recepção
lnProximaLinha = wsResumo.Range("B65536").End(xlUp).Row + 1

'Transferir os dados desejados
wsResumo.Range("B" & lnProximaLinha & ":D" & lnProximaLinha) = VlorDados
MsgBox "Valores da Linha " & lnLinhaAtiva & " Copiados para planilha Resumo!"

End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel




  Baixe o exemplo de planilha contendo a macro acima
vba copia itens selecionado para outra planilha (41.8 kB 2010-11-20 18:43:19)