Notifications
Clear all

Copiar Certas Abas (Sheets) usando VBA

4 Posts
2 Usuários
0 Reactions
1,002 Visualizações
(@yatagan)
Posts: 0
New Member
Topic starter
 

Pessoal estou com um problema, Tenho um arquivo com 5 abas, ma na 2 aba coloquei um botão salvar como, funciona tudo certinho ele copia a aba 2 e cria um novo arquivo, mas eu queria que esse código estendesse a 2 abas, a aba2 e a aba5 como faço? uso um codigo que peguei aqui

Sub Salvar()
'Working in Excel 2000-2010
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then


        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:=Range("F3"), _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="SALVAR FICHA DO PACIENTE")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveWorkbook.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:=Range("F3"), filefilter:= _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm", _
        FilterIndex:=5, Title:="SALVAR FICHA DO PACIENTE")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing
                 
                 MsgBox "FICHA SALVA COM SUCESSO!", vbExclamation, "SALVO!"
            End If
        End If
    End If
End Sub
 
Postado : 26/04/2017 11:58 am
(@brunoxro)
Posts: 0
New Member
 

Boa tarde yatagan,

Coloque um arquivo de exemplo, assim fica mais fácil ajudar.

att,

 
Postado : 26/04/2017 3:44 pm
(@yatagan)
Posts: 0
New Member
Topic starter
 

Quero que esse botão não copia apenas a aba em que ele está, mas sim ela e a Sheet3.
Mandei o arquivo, ela é obrigatório a ser salvo em formato não macro, por questão de espaço, no meu arquivo original com macro ela digitara tudo do Paciente e apertara o botão para criar um arquivo especifico pra ela, e esse arquivo não precisará de macros.
Obrigado

 
Postado : 27/04/2017 6:57 pm
(@brunoxro)
Posts: 0
New Member
 

Boa noite,

Para não alterar muito o seu código, eu adicionei duas linhas.

No caso, mude o 'Sheet1', 'Planilha1' e 'Planilha2' para o nome das planilhas que deseja salvar.

Sheets(Array("Sheet1", "Planilha1", "Planilha2")).Copy

Teste e veja se o resultado é o desejado.

att,

 
Postado : 28/04/2017 3:29 pm