Adicionado em: | 13/04/2011 |
Modificado em: | 13/04/2011 |
Tamanho: | Vazio |
Downloads: | 919 |
Saberexcel - o site de quem precisa Aprender Microsoft Excel VBA
Esta macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), copia e cola a ultima linha na coluna B na folha de planihas. Exemplo poderá servir em muitas situações
Sub Copia_ultima_linha()
Dim DadosRange As Range
Dim vUltimaLinha As Integer
Dim vCelula As Range
r = 6
vUltimaLinha = Cells(Rows.Count, "B").End(xlUp).Row
Set DadosRange = Range("B4:B" & vUltimaLinha)
For Each vCelula In DadosRange
If vCelula.Value > 0 Then
vCelula.EntireRow.Copy
Sheets("Plan1").Range("A" & r).PasteSpecial xlPasteValues
r = r + 1
End If
Next vCelula
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
Publicidade
Compre com segurança, garantia e ótimos preços
Adicionado em: | 20/11/2010 |
Modificado em: | 20/11/2010 |
Tamanho: | Vazio |
Downloads: | 943 |
Essa macro do Aplicativo Microsoft Excel VBA, copia os dados da planilha principal, adiciona planilha com os nomes existente na Coluna(A), e preenche cada planilha com os dados correspondente. Essa planilha poderá ser muito boa para fazer relatórios de vendedores, separadamente, a macro abrirá uma planilha para cada vendedor e distribuirá todos os dados existentes.
Sub Copia_dados_distribuindo_em_planilhas()
Dim vPlanPrincipal As String
Dim vLinha As Integer
Dim vContinuar As Boolean
Dim vColPrincipal As String
Dim vColATeste As String
Deleta_Planilhas_Exceto_Desejada
'memorizando o nome da folha que contém os dados
vPlanPrincipal = ActiveSheet.Name
'Inicialize as variáveis
vContinuar = True
vLinha = 2
'Comece a comparar com a célula A2
vColPrincipal = "A2"
'O laço por todos os valores de coluna A até uma célula em branco é encontrado
While vContinuar = True
vLinha = vLinha + 1
vColATeste = "A" & CStr(vLinha)
'Encontrado uma célula em branca, não continuar
If Len(Range(vColATeste).Value) = 0 Then
vContinuar = False
End If
'A ocorrência encontrada que não combinou, dados de cópia à nova folha
If Range(vColPrincipal).Value <> Range(vColATeste).Value Then
'Títulos de cópia
Range("A1:D1").Select
Selection.Copy
'Acrescente a nova folha e cole títulos na nova folha
Sheets.Add.Name = Range(vColPrincipal).Value
ActiveSheet.Paste
Range("A1").Select
'Dados de cópia de colunas A - D
Sheets(vPlanPrincipal).Select
Range(vColPrincipal & ":D" & CStr(vLinha - 1)).Select
Selection.Copy
'colando resultados
Sheets(Range(vColPrincipal).Value).Select
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
'voltando à folha principal continuando onde foi deixado
Sheets(vPlanPrincipal).Select
vColPrincipal = "A" & CStr(vLinha)
End If
Wend
Range("A1").Select
Application.CutCopyMode = False
MsgBox "Dados copiados com sucesso em planilhas separadas", vbInformation, "SaberExcel - Site das Macros"
End Sub
Essa macro do Aplicativo Microsoft Excel VBA , deleta todas as planilhas de um determinado livro e preserva a planilha desejada, neste caso usamos a macro como auxíliar para deletar as macros e completar o teste do usuário desenvolvedor.
Sub Deleta_Planilhas_Exceto_Desejada()
Dim resposta As String
resposta = MsgBox("Deseja deletar as planilhas e preservar a planilha [Dados]", vbYesNo + vbCritical, "Saberexcel - site das macros")
If resposta = 6 Then
For Each Plan In Worksheets
Application.DisplayAlerts = False 'impede de emitir a mensagem se deseja excluir
If Plan.Name <> "Dados" Then
Plan.Delete
End If
Next
End If
End Sub
Aprenda Aplicativo Microsoft Excel VBA - SaberExcel
Adicionado em: | 20/11/2010 |
Modificado em: | 20/11/2010 |
Tamanho: | Vazio |
Downloads: | 1047 |
Essa macro do Aplicativo Microsoft Excel VBA, contém uma macro que copia dados referente a um determinado intervalo de datas e cola em outra folha de planilha também no mesmo intervalo de datas.
Sub Copiar_dados_para_outra_plan()
Dim vData As String
Dim vColuna As Integer
Dim vEncontrar As Boolean
On Error GoTo Err_Execute
'Retorna o valor da data
vData = Sheets("Planilha Dados").Range("B4").Value
Sheets("Plan").Select
'inicia na coluna(B)
vColuna = 2
vEncontrar = False
While vEncontrar = False
'se encontrar uma célula em branco na linha 2, termina a busca
If Len(Cells(2, vColuna)) = 0 Then
MsgBox "Dados não encontrados.", vbInformation, "http://www.saberexcel.com"
Exit Sub
'dados encontrado após a linha 2
ElseIf Cells(2, vColuna) = vData Then
'Seleciona valor para copiar da "Planilha Dados"
Sheets("Planilha Dados").Select
Range("B5:H6").Select
Selection.Copy
'Cola na "Plan"
Sheets("Plan").Select
Cells(3, vColuna).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
vEncontrar = True
MsgBox "Os dados foram copiados com sucesso!!", vbInformation, "http://www.saberexcel.com"
'continua a procura
Else
vColuna = vColuna + 1
End If
Wend
On Error GoTo 0
Exit Sub
Err_Execute:
MsgBox "Ocorreu um #erro#!", vbInformation, "http://www.saberexcel.com"
End Sub
Adicionado em: | 20/11/2010 |
Modificado em: | 20/11/2010 |
Tamanho: | Vazio |
Downloads: | 1149 |
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 Aplicativo Microsoft Excel VBA - SaberExcel - o Site das Macros
Adicionado em: | 31/10/2011 |
Modificado em: | 31/10/2011 |
Tamanho: | Vazio |
Downloads: | 1204 |
Saberexcel - o site de quem precisa aprender Micros Microsoft Excel VBA
Estes macro do aplicativo Microsoft Excel VBA, copia os dados da célula Plan2(I7) para as células F7 e I5 da Plan1, também fiz um macro que copia
dados de outro livro ativo para uma determinada folha planilha. Espero que os exemplos possam lhe ser útil. fique com Deus, Expedito Marcondes
'- - - - - - - - - -
Sub sbx_copia_Dados()
Saber1.Range("F7") = Saber2.Range("I5").Value
Saber1.Range("F7").Copy Saber1.Range("I5")
Application.CutCopyMode = False
MsgBox ("Dados copiados com o macro 'sbx_copia_dados'"), vbInformation, "Saberexcel - o site das macros"
End Sub
'- - - - - - - - - -
Sub sbx_copiar_saberexcel()
Saber1.[F7] = Saber2.[I5]
Saber1.[F7].Copy Saber1.[I5]
MsgBox ("Dados copiados com o macro 'sbx_copiar_saberexcel'"), vbInformation, "Saberexcel - o site das macros"
End Sub
'reproduza o exemplo deste macro para teste, pois não fiz neste livro exemplo. (por precisar de 2) ok...
Sub sbx_copiando_dados_outro_livro()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim vRange1 As Range, vRange2 As Range
Set wkb1 = Workbooks("wkb1") 'nome do primeiro livro
Set wkb2 = Workbooks("wkb2") 'nome do segundo livro
Set vRange1 = wkb1.Worksheets("Plan1").Range("A1")
Set vRange2 = wkb2.Worksheets("Plan1").Range("A1")
[vRange1].Copy [vRange2].PasteSpecial 'xlPasteValues
End Sub
'- - - - - - - - - -
Sub sbx_limpar_teste()
Saber1.[F7,I5].ClearContents
End Sub
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.
Adquira já o Acesso Imediato
à Area de Membros
Aprenda Excel VBA com Simplicidade de
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.
'-------------------------------------'
Entrega Imediata:
+ 500 Video Aulas MS Excel VBA
+ 35.000 Planilhas Excel e VBA
+ Coleção 25.000 Macros MS Excel VBA
+ 141 Planilhas Instruções Loops
+ 341 Planilhas WorksheetFunctions(VBA)
+ 04 Módulos Como Fazer Excel VBA
+ Curso Completo MS Excel VBA
+ Planilhas Inteligentes
<script type="text/javascript"><!--
google_ad_client = "ca-pub-2317234650173689";
/* retangulo 336 x 280 */
google_ad_slot = "0315083363";
google_ad_width = 336;
google_ad_height = 280;
//-->
</script>
<script type="text/javascript"
src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,
Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA