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