Copy multiple sheets into a single file

Asked

Viewed 205 times

0

Good afternoon, I made a code to capture a Sheets of a given spreadsheet, however now I want to take more than one and save all in a single file, but I’m not getting anyone could 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

  • What is the mistake that is happening? Could you elaborate better, please?

  • I suggest separating in different functions each step of your code to facilitate both learning in VBA and reading your code. Create function to open/choose file, function to read all sheets and so on.

No answers

Browser other questions tagged

You are not signed in. Login or sign up in order to post.