Notifications
Clear all

Exportar determinadas Plans

11 Posts
3 Usuários
0 Reactions
2,932 Visualizações
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Boa tarde, Galera!

Procurei no banco de dados, mas não tive sucesso no que procurava...

Tenho um arquivo excel com 10 plans (plan1, plan2, plan3, plan4...)
Preciso de uma macro que exporte a plan2, plan4, e plan8 para o mesmo arquivo, e que criasse uma pasta de trabalho caso não haja e salve-a a exportação no mesmo diretório.

Att,

 
Postado : 24/05/2013 12:41 pm
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

wagnermedani,

Boa Tarde!

Veja se assim te atende.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 24/05/2013 1:27 pm
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Wagner Morel

Obrigado.

Acrescentei o seguinte comando para deletar as plans 1, 2 e 3 do novo arquivo:

Sheets(Array("Plan1", "Plan2", "Plan3")).Select
ActiveWindow.SelectedSheets.Delete

Só que sempre aparece a mensagem que tem itens selecionados e solicitando para excluir, é possível eliminar esta mensagem e salvar direto?

Att,

 
Postado : 24/05/2013 2:25 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Tente

Sub AleVBAMenssagem() 
     
    Application.displayalerts = False 
      Sheets(Array("Plan1", "Plan2", "Plan3")).Select
      ActiveWindow.SelectedSheets.Delete
    Application.displayalerts = True 
     
End Sub 

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

 
Postado : 24/05/2013 3:31 pm
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Alexandrevba e Wagner Morel,
Obrigado, funcionou perfeitamente.

Uma última coisa para finalizar, quanto na criação do novo arquivo, se o mesmo já existe, ele informa se deseja substituir, se clicar em cancelar, o mesmo da erro, gostaria que simplesmente abortasse a operação.

Att,

 
Postado : 25/05/2013 8:01 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não vi qual rotina está utilizando, mas é só adaptar a abaixo:

Private Sub MsgSalvarComo()

    Dim sMsg
        
    sMsg = MsgBox("Deseja salvar um novo arquivo", vbYesNo + vbDefaultButton1 + vbQuestion, _
                      "Salvar Como")
    
    Application.EnableEvents = False
    
    Cancel = True
    
    If sMsg = vbYes Then
    
       Application.Dialogs(xlDialogSaveWorkbook).Show
       
    ElseIf sMsg = vbNo Then
    
        MsgBox " cancelou"
        
    Else
    
        Cancel = True
        
    End If
    
    Application.EnableEvents = True
   
End Sub

[]s

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

 
Postado : 25/05/2013 9:02 am
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Mauro Coutinho,

Fiz uma adaptação pela rotina apresentada, mas não é o que estou querendo de fato.
A minha rotina esta funcionando legal, o problema é que se ele identifica que existe um arquivo do mesmo nome, ele apresenta uma msg perguntando se deseja substituir, se sim, blz, mas se optar por não ou cancelar, da erro em SalveAs.

Att,

 
Postado : 25/05/2013 10:12 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Mas como eu disse, eu não sei qual a estrutura da sua rotina, então é só aproveitar as linhas que evitam o erro :

Aqui aparece uma mensagem se deseja Salvar :
sMsg = MsgBox("Deseja salvar um novo arquivo", vbYesNo + vbDefaultButton1 + vbQuestion, _
"Salvar Como")

'Congela o andamento da rotina
Application.EnableEvents = False

Cancel = True

Estas linhas são as que capturam o valor do Botão
Se escolheu SIM continua
If sMsg = vbYes Then

Application.Dialogs(xlDialogSaveWorkbook).Show

'Se escolheu NÃO ou CANCELAR sai da rotina sem dar a mensagem de erro
ElseIf sMsg = vbNo Then

MsgBox " cancelou"

Else

Cancel = True

End If

'Desfaz o congelamento da rotina
Application.EnableEvents = True

Se ainda não conseguir, poste a rotina que está utilizando e fazemos a adaptação.

[]s

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

 
Postado : 25/05/2013 10:35 am
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Estou usando esta rotina:

Dim Qtde As Byte
    Workbooks.Add
    ActiveWorkbook.SaveAs (Workbooks("Dados.xls").Path & "Central Pasargada.xls")
    
    Qtde = Sheets.Count
    Workbooks("Dados.xls").Activate
    Sheets(Array("Central", "Filhos", "Médico")).Select
    Sheets(Array("Central", "Filhos", "Médico")).Copy Before:=Workbooks("Central Pasargada.xls"). _
        Sheets(Qtde)
        
    Application.DisplayAlerts = False
      Sheets(Array("Plan1", "Plan2", "Plan3")).Select
      ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
      
    Workbooks("Central Pasargada.xls").Save
    Workbooks("Central Pasargada.xls").Close
    MsgBox "Central Pasargada exportado com sucesso", vbDefaultButton1, "SALVAR"
 
Postado : 25/05/2013 10:46 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

wagner, antes eu gostaria de saber qual a ação pretende.

"se o mesmo já existe, ele informa se deseja substituir, se clicar em cancelar, o mesmo da erro, gostaria que simplesmente abortasse a operação."
Pelo que entendi na parte da rotina que postou, você sempre irá Salvar o arquivo com o mesmo nome, então se for só pela mensagem que aparece, é só deslocar a instrução : Application.DisplayAlerts = False para alinha logo após : Workbooks.Add, se abortarmos a operação neste ponto, o restante da rotina não irá continuar.

Feito isto a única mensagem que terá é a que está no final da rotina :
MsgBox "Central Pasargada exportado com sucesso", vbDefaultButton1, "SALVAR"

Agora se quer algo diferente, passe o que quer que faço as alterações.

[]s

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

 
Postado : 25/05/2013 12:08 pm
(@wagnermedani)
Posts: 39
Eminent Member
Topic starter
 

Desculpe-me a minha ignorância.

Muitíssimo obrigado pela atenção.

 
Postado : 25/05/2013 12:19 pm