Saberexcel - o Site das Macros
Essa macro do Aplicativo Microsoft Excel VBA, contém macro que copia determinados dados de uma planilha e salva novos Workbook com nome dos dados existentes na coluna(A), foi escolhido o Diretório C:\VBA\ , mas você poderá indicar um novo caminho para seu computador, para entender melhor baixe a planilha exemplo.

Sub Copiar_dados_novos_wkb_salvar()

Dim wbkPrincipal As String
Dim vNovoWkb As String
Dim vLinha As Integer
Dim vContinuar As Boolean

Dim vColAMestre As String
Dim vColATeste As String

Dim WkbContador As Integer
Dim vMensagem As String

Dim vDiretorio As String
Dim vArquivoNome As String

Dim vColAValor As String

'Diretorio onde salvará os novos Workbooks
vDiretorio = "C:\VBA\"

'Retorna o nome do workbook contendo os dados a serem copiados
wbkPrincipal = ActiveWorkbook.Name

'Inicilizando com variáveis
vContinuar = True
vLinha = 2
WkbContador = 0

'Inicio da comparação com a célula(A2)
vColAMestre = "A2"

'Loop em todos os ítemns coluna (A) até encontrar encontrar uma célula em branco
While vContinuar = True

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

'Quando encontrar um célula em branco, sai do loop
If Len(Range(vColATeste).Value) = 0 Then
vContinuar = False
End If

'Valor que esta na coluna(A)
vColAValor = Range(vColAMestre).Value

'A ocorrência encontrada que que não combina, é copiada para o novo livro de exercícios
If vColAValor <> Range(vColATeste).Value Then

'Copiando o cabeçalho
Range("A1:D1").Select
Selection.Copy

'Adicionando novo Workbook e colando o cabeçalho no novo Wkb Livro
Workbooks.Add
vNovoWkb = ActiveWorkbook.Name
ActiveSheet.Paste
Range("A1").Select

'Copiando os dados da coluna A - D
Windows(wbkPrincipal).Activate
Range(vColAMestre & ":D" & CStr(vLinha - 1)).Select
Selection.Copy

'Colando os resultados
Windows(vNovoWkb).Activate
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
On Error Resume Next 'tratando um possível erro

'Salvando os Workboks se necessário com o nome das frases da coluna A
'e logo fechando o livro de exercícios
vArquivoNome = vDiretorio & vColAValor & ".xls"
If Dir(vArquivoNome) <> "" Then Kill vArquivoNome
ActiveWorkbook.SaveAs Filename:=vArquivoNome
ActiveWorkbook.Close

'Voltando para a planilha principal ao ponto desejado
Windows(wbkPrincipal).Activate
vColAMestre = "A" & CStr(vLinha)

'variável contador emite na msgbox quantas planilhas foram salvas
WkbContador = WkbContador + 1

End If

Wend

Range("A1").Select
Application.CutCopyMode = False

vMensagem = "Dados copiados com sucesso! copiados para [ " & WkbContador & " ] novos Workbook."
vMensagem = vMensagem & Chr(10) & "Salvo no Diretório : [ " & Chr(10) & vDiretorio & " ]"

MsgBox vMensagem, vbInformation, "Saberexcel - o Site das Macros"

End Sub

Aprenda Aplicativo Microsoft Excel VBA com SaberExcel

Saberexcel - o site das macros
Esses procedimentos do Aplicativo Microsoft Excel VBA, copia os dados da linha selecionada para a coluna(A1), selecionado o e listando os dados desejados. Isso com auxlio de uma entrada de dados (Inputbox)
Observe que usei a propriedade OffSet para deslocar uma linha abaixo para colar os dados.
É muito importante aprender sobre esta propriedade para um bom aprendizado em VBA, temos excelentes exemplos nos módulos COMO FAZER - Programação MS Excel VBA - Saberexcel.

Private Sub Worksheet_Activate()
Application.EditDirectlyInCell = False
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim vCelula As Long
Dim vEndereco As String

vCelula = ActiveCell.Row
vEndereco = Cells(vCelula, 3)
vEndereco = vEndereco & ", " & Cells(vCelula, 4)
vEndereco = vEndereco & ", " & Cells(vCelula, 5)
vEndereco = vEndereco & ", " & Cells(vCelula, 6)
vEndereco = vEndereco & ", " & Cells(vCelula, 7)

vEndereco = InputBox("Selecione a linha desejada!", Cells(vCelula, 4) & " - " & Cells(vCelula, 5) & "- [ Saberexcel ] ", vEndereco)
[A65000].End(xlUp).Offset(1, 0).Select 'deslocando para primeira célula em branco
ActiveCell.Value = vEndereco

End Sub



Aprenda tudo sobre o aplicativo Microsoft Excel VBA com 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

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

Esccola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Esse macro do aplicativo MS Excel VBA(Visual Basic Application), cria folha de planilhas planiihas com nome e dados dos alunos, com auxlio do Evento
Duplo Click, ou seja Cria uma planilha com dados do aluno nome do Aluno, com base no exemplo já existe.
as cores das abas de planihas criadas são geradas aleatóriamente (56) cores.
'a planilha modelo {Ficha_Aluno} ficará oculta.

Private Sub Worksheet_Activate()
fl_Aluno.Visible = False
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Range("A2:A1000"), Target) Is Nothing Then Exit Sub
vNome = ActiveCell
If vNome = "" Then Exit Sub
vIDADE = ActiveCell.Offset(0, 1)
vENDERECO = ActiveCell.Offset(0, 2)
vLICAO = ActiveCell.Offset(0, 3)
vNOTAS = ActiveCell.Offset(0, 4)

'para adicionar em outros campos
'vNome1= activecell.offset(0,5)
'vNome2= activecell.offset(0,6)

'testar se a planilha Ficha_Alunos (duplicação da planilha Ficha_Aluno - com o nome do Aluno)
For Each sh In Worksheets
If sh.Name = vNome Then MsgBox " Ficha_Aluno " & vNome & " planilha já foi criada!", vbCritical, "ERRO": Exit Sub
Next

Sheets("Ficha_Aluno").Visible = True

Sheets("Ficha_Aluno").Copy After:=Sheets(Worksheets.Count)
Sheets("Ficha_Aluno (2)").Select
Sheets("Ficha_Aluno (2)").Name = vNome
Sheets("Ficha_Aluno (2)").Tab.ColorIndex = Int(55 * Rnd) + 1
Sheets(vNome).Tab.ColorIndex = Int(55 * Rnd) + 1
Sheets("Ficha_Aluno").Select
ActiveWindow.SelectedSheets.Visible = False

Sheets(vNome).Select
Sheets(vNome).Range("B2") = vNome
Sheets(vNome).Range("B4") = vIDADE
Sheets(vNome).Range("B6") = vENDERECO
Sheets(vNome).Range("B8") = vLICAO
Sheets(vNome).Range("B10") = vNOTAS
Sheets(vNome).Range("A1").Select

End Sub

Sub deletar_planilhas()
Dim i As Long
On Error Resume Next
Application.DisplayAlerts = False
For i = 1 To Sheets.Count
If Len(Sheets(i).Name) = 1 And Sheets(i).Visible = True Then
Sheets(i).Delete
End If
Next i
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.