Saberexcel - o site das Macros
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 tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel
Baixe a planilha exemplo do aplicativo ms excel vba com a macro acima
vba copia add planilhas com respectivos dados (30.54 kB 2010-11-20 18:30:48)