Notifications
Clear all

Macro especifica para criar Novo Workbook

21 Posts
4 Usuários
0 Reactions
3,256 Visualizações
 omar
(@omar)
Posts: 22
Eminent Member
Topic starter
 

Pessoal, consultei no fórum mais não consegui encontrar algo neste formato, se alguém poder indicar um link ou dar uma ajuda ficaria agradecido.

Em uma pasta de trabalho no Excel que possui 6 planilhas (ABAS) gostaria de uma macro que copie somente 3 destas planilhas em uma nova pasta de trabalho com o nome especifico (As 3 planilhas juntas em uma nova pasta de trabalho com o nome de uma determinada célula), Todos os posts que eu achei relacionado, somente mostra como como criar uma nova pasta de trabalho, , ou copiar uma planilha para outra pasta já criada.

Obrigado!

 
Postado : 11/03/2016 9:43 am
 omar
(@omar)
Posts: 22
Eminent Member
Topic starter
 

Boa tarde!
Mprudencio,

Segue planilha exemplo, o que eu preciso é quando clicar o botão salvar que esta na aba "Resumo", cria um novo arquivo somente com as abas listadas abaixo e salva automaticamente em uma pasta (Diretório especifico), com o nome das células B6 + B9, Não precisa abrir o novo arquivo criado. somente salvar na pasta. Acredito que por este método do Array, fica mais fácil para realizar alterações ou adaptações futuras, caso seja incluído novas abas no arquivo.

Abas que deverão ser copiadas para a nova pasta:

Resumo
SERV-Matriz
SERV-TERCEIRIZADA
MAT_ALMOX
MAT_TMS

Desde já obrigado cara.

 
Postado : 16/03/2016 10:35 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

omar, adaptando meu código:

Option Explicit

Sub PlanilhaCliente()
Dim wsAtiva     As Worksheet
Dim wsSave()    As Variant
Dim sArquivo    As String
Dim sNome       As String
Dim i           As Long
Dim j           As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wsAtiva = ThisWorkbook.ActiveSheet
    
    sArquivo = "C:Clientes"
    sNome = wsAtiva.Cells(6, 2).Value & wsAtiva.Cells(9, 2).Value
    wsSave = Array("Resumo", "SERV-Matriz", "SERV-TERCEIRIZADA", "MAT_ALMOX", "MAT_TMS")

    ActiveWorkbook.SaveCopyAs Filename:=sArquivo & sNome & ".xlsm"
    SetAttr sArquivo & sNome & ".xlsm", vbHidden
    
    Workbooks.Open Filename:=sArquivo & sNome & ".xlsm"
    Windows(sNome & ".xlsm").Activate
    
    For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
        For j = 0 To Application.WorksheetFunction.CountA(wsSave) - 1
            If ActiveWorkbook.Worksheets(i).Name = wsSave(j) Then
                GoTo Proximo
            End If
        Next j
        ActiveWorkbook.Worksheets(i).Delete
Proximo:
    Next i
    
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    SetAttr sArquivo & sNome & ".xlsm", vbNormal

    MsgBox "Planilha criada com sucesso!" & vbNewLine & _
        "Nome da planilha: " & sNome & ".xlsx" & vbNewLine & _
        "Local da planilha: " & sArquivo

final:
    
    Set wsAtiva = Nothing
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/03/2016 11:43 am
 omar
(@omar)
Posts: 22
Eminent Member
Topic starter
 

Bernardo, obrigado pelo retorno, porém o código com o array (passado pelo Leonardo) e mais fácil para eu que sou leigo compreender e conseguir alterar se necessário. Adaptei ele na planilha em anexo, a única coisa que não consegui foi salvar ele em um diretório no c:, já nomeado com o valor da célula B6 e K6 (nº OS - Nome Cliente) da Aba Resumo. Se você conseguir da uma dica ficarei muito grato.

 
Postado : 18/03/2016 7:29 am
(@mprudencio)
Posts: 2749
Famed Member
 

Ve se é esse o resultado que vc queria.

A macro esta associada ao botao Gravar OS

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 18/03/2016 7:54 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cara, meu último código eu fiz com array. Basta inserir os nomes das planilhas no array wsSave.

Para alterar eu teria preguiça de alterar o código apresentado no anexo. Cheio de Select/Selection, copy/paste, atribuição de referencia sem limpara a memória... ... ...

Mas se deseja utilizar esse e quer apenas essa alteração, troque a linha:

Application.Dialogs(xlDialogSaveAs).Show

por essa:

ActiveWorkbook.SaveAs "C:" & Worksheets("Resumo").Cells(6, 2).Value & Worksheets("Resumo").Cells(9, 2).Value & ".xlsx"

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 18/03/2016 7:57 am
 omar
(@omar)
Posts: 22
Eminent Member
Topic starter
 

Obrigado Bernardo.

MPrudencio, ficou perfeito, valeu mesmo pela ajuda cara.

 
Postado : 18/03/2016 8:55 am
Página 2 / 2