Copy multiple sheets into a single file

0

Good afternoon, I made a code to capture a sheets of a certain worksheet, but now I want to take more than one and save all in a single file, but I can not get someone to help me?

Private Sub btnRelatorio_Click()

    Dim chamarWb As Workbook
    Dim Destwb As Workbook
    Dim caminhoTemp As String
    Dim caminhoNome As String
    Dim sExtensao As String
    Dim nome As String
    Dim Plan As String

    
    Do Until Worksheets_Existe(Plan)
    Plan = InputBox("Informe o nome da planilha")
    If Not Worksheets_Existe(Plan) Then MsgBox Plan & " Não existe!", vbExclamation
    Loop
    
    Sheets(Plan).Select
    
    sExtensao = Mid(ThisWorkbook.FullName, (InStrRev(StringCheck:=ThisWorkbook.FullName, StringMatch:=".", Compare:=vbTextCompare)))

    MFIR = Replace(Range("c5").Value, ",", "")
    NOME_CLIENTE = Replace(Range("c4").Value, ",", "")
    
    nome = MFIR & "_" & correto(NOME_CLIENTE) & "_" & Format(Date, "dd-mm-yyyy") & ".xls"
 
    With Application
    
    .ScreenUpdating = False
    .EnableEvents = False
    
    End With
 
    Set chamarWb = ActiveWorkbook
 
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    caminhoTemp = ThisWorkbook.Path & "\"
  
    caminhoNome = nome
 
    With Destwb
        
    .SaveAs caminhoTemp & caminhoNome
      
    End With
 
MsgBox "Seu arquivo se encontra no caminho " & caminhoTemp
 
    With Application

    End With
    
    Workbooks(nome).Close SaveChanges:=False

    Call Macro2
    
    Unload FormSalvar

    End Sub
    
asked by anonymous 26.09.2017 / 20:10

0 answers