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

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

Saberexcel - o site das macros
Essa macro do Aplicativo Microsoft Excel VBA, contém macro que copia determinados dados para outra folha de planilha.

Sub Copiar_Dados()

Dim vLinha As Integer
Dim vColACelulas As String
Dim vContinuar As Boolean

'Seleciona Plan1
Sheets("Plan1").Select
Range("A2").Select

'inicializando variáveis
vContinuar = True
vLinha = 2

'O loop por todos os valores de coluna A até uma célula em branco é encontrado ou o valor não faz
'combina com a célula valor de A2
While vContinuar = True

vLinha = vLinha + 1
vColACelulas = "A" & CStr(vLinha)

'encontrando uma célula em branco, não continua
If Len(Range(vColACelulas).Value) = 0 Then
vContinuar = False
End If

'A primeira ocorrência encontrada que não combinou com a célula valor de A2, não continua
If Range("A2").Value <> Range(vColACelulas).Value Then
vContinuar = False
End If

Wend

'Dados da cópia de colunas A - C
Range("A2:C" & CStr(vLinha - 1)).Select
Selection.Copy

'cola na planilha(Plan2) na célula (A1)
Sheets("Plan2").Select
Range("A1").Select
ActiveSheet.Paste

MsgBox "Dados copiados com sucesso", vbInformation, "Saberexcel - o site das macros"

End Sub

Aprenda Aplicativo Microsoft Excel VBA SaberExcel

Essa macro do Aplicativo Microsoft Excel VBA, copia os dados da coluna(A) para a Coluna(C), observe que macro copia os dados o números de vezes que foi atribuido na célula representando a quantidade

Sub copia_para_coluna_C()

Dim vLinha As Integer
Dim vQtd As Integer
Dim vProduto As String
Dim vColunaPosicao As Integer
Dim j As Integer
Dim vInicio As Integer
Dim vFinal As Integer

'Pesquisa de valores em coluna B que começa em linha 2
vLinha = 2

'copia valores para coluna C começando na linha 2
vColunaPosicao = 2

'Pesquise em valores na coluna B até que uma célula em branco seja encontrada
While Len(Range("B" & CStr(vLinha)).Value) > 0

'Recupere o nome de produto e a quantidade
vQtd = Range("A" & CStr(vLinha)).Value
vProduto = Range("B" & CStr(vLinha)).Value

' posicionando o fim para cópia a coluna C
vInicio = vColunaPosicao
vFinal = vColunaPosicao + vQtd

'O copia o número de dados que é dado que é representado pela quantidade
For j = vInicio To vFinal - 1
Range("C" & CStr(j)).Value = vProduto
Next

'atualiza a posição na coluna C
vColunaPosicao = vFinal

vLinha = vLinha + 1

Wend

MsgBox "Copiou os dados para a coluna C.", vbInformation, "www.saberexcel.com"
End Sub

Sub limpar()
Range("C2:C1000").ClearContents
End Sub


Aprenda Aplicativo Microsoft Excel VBA - Saberexcel

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