|
 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
|