Srs Boa tarde!
Estou precisando de uma grande ajuda.
Tem uma lista de amostras de inventario Florestal e cada amostra precisa ser um arquivo diferente, então, em uma Planilha tenho todas as amostras que precisarão ser feitas, que são muitas.
Preciso de um código vba, que faça um loop na aba cadastros e crie um arquivo para todas as amostras da coluna A, que vai de Amostra 1 à amostra 50, mais isto pode variar, Ex: um arquivo com o Nome Amostra 1, outro com o nome Amostra 2, outro com o nome Amostra 3, etc, e para cada arquivo deverá copiar a Aba formulário, desta forma, vou precisar ter 50 arquivos, e em cada arquivo terei a aba formulário, para que eu possa registrar os dados das amostras realizadas.
Alguém poderia me ajudar, estou precisando muito.
Não consegui anexar o modelo..
Preciso que os arquivos sejam salvos em C:\Users\edson.silva\Documents\Inventario
Desde já agradeço.
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Salvar como com VBA
-
- Acabou de chegar
- Mensagens: 2
- Registrado em: Dom Abr 23, 2017 2:22 pm
Re: Salvar como com VBA
Edson_Silva,
Coloque esta rotina em um módulo e chame a mesma através de um botão.
Abs
Coloque esta rotina em um módulo e chame a mesma através de um botão.
Código: Selecionar todos
Sub criar_Formularios()
'Desabilitamos a atualização de tela
Application.ScreenUpdating = False
'Laço For => Next para retornar os números contidos na Coluna A
'Iniciando a partir da linha 2 até a ultima preenchida
For listaAmostras = 2 To .UsedRange.Rows.Count
'Ativamos a Pasta de trabalho onde essa rotina está
Windows(ThisWorkbook.Name).Activate
'Selecionamos a Aba AMOSTRAS
ThisWorkbook.Sheets("AMOSTRAS").Activate
'Selecionamos a linha 2 da Coluna A
.Cells(listaAmostras, "A").Select
'Variável para armazenar o número contido nela
Dim idAmostra As String
'Atribuimos o valor da célula na variável
idAmostra = ActiveCell.Value
'Se o valor da variável for diferente de nulo
If idAmostra <> "" Then
'Selecionamos a Aba FORMULÁRIO
Sheets("FORMULÁRIO").Select
'Copiamos a mesma para uma nova pasta
Sheets("FORMULÁRIO").Copy
'Salvamos o arquivo no local determinado
ActiveWorkbook.SaveAs "C:\Users\edson.silva\Documents\Inventario\" & "Amostra_" & idAmostra, FileFormat:=xlWorkbookDefault
'Fechamos a pasta atual
ActiveWorkbook.Close
Else
'Senão saimos do laço
Exit For
End If
Next
'Ativamos a atualização de tela
Application.ScreenUpdating = True
'Mensagem de conclusão da rotina
MsgBox "Total de " & idAmostra & " arquivo(s) criado(s) com sucesso!", vbInformation, "Criação de Formulários para Amostras"
End Sub
-
- Acabou de chegar
- Mensagens: 2
- Registrado em: Dom Abr 23, 2017 2:22 pm
Re: Salvar como com VBA [RESOLVIDO]
Bom dia!
Muito obrigado, ficou muito bom....
Deus abençoe...
Fiz um pequena adaptação nas linha abaixo
For listaAmostras = 2 To Sheets("Amostras").UsedRange.Rows.Count
Sheets("Amostras").Cells(listaAmostras, "A").Select
Pois não esta encontrando a referencia da aba.
Muito obrigado, ficou muito bom....
Deus abençoe...
Fiz um pequena adaptação nas linha abaixo
For listaAmostras = 2 To Sheets("Amostras").UsedRange.Rows.Count
Sheets("Amostras").Cells(listaAmostras, "A").Select
Pois não esta encontrando a referencia da aba.
Re: Salvar como com VBA
Edson_Silva,
Opa que bom que atendeu ás suas necessidades amigo!.
Abs e fique com Deus.
Opa que bom que atendeu ás suas necessidades amigo!.
Abs e fique com Deus.