activate workbook and worksheet according to variable value

[Ulisses_Carso]

Good Morning guys

I have this code that used to always create a "Master.xlsx" file, but I had to change it to include the date in the file name, but with this change my code started to give an error when activating the workbook to copy the data.

I check and when activating the folder the variable contains the path and name of the file but it is working, I had to make a shortcut so that it works temporarily, but that way I have the right order to open the sheets without the error script.

There are some commented lines that were the way the code worked before, it's an annoying error that I can't solve.

I'll post the entire code as the problem may not necessarily be on the line with the error.

I thank the help of all you!!!

Sub MesclarArquivos()

Dim bookList As Workbook
Dim FolderPath As String, FileName As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
With Application.FileDialog(4)
   .AllowMultiSelect = False
   If .Show Then
      FolderPath = .SelectedItems(1)
   Else
      Exit Sub
   End If
End With

Set dirObj = mergeObj.Getfolder(FolderPath & "\")

FileName = FolderPath & "\Master - " & Format(Now(), "dd-mm-yy - hh-mm")
'FileName = FolderPath & "\Master.xlsx"

If Dir(FileName) = "" Then
    Workbooks.Add.SaveAs FileName:=FolderPath & "\Master - " & Format(Now(), "dd-mm-yy - hh-mm")
'    Workbooks.Add.SaveAs FileName:=FolderPath & "\Master.xlsx"
    Sheets("planilha1").Name = "Master"
Else
    MsgBox "O arquivo já existe na pasta.", vbInformation
    Exit Sub
End If

Set filesObj = dirObj.Files


For Each everyObj In filesObj
        
    If everyObj = (FileName & ".xlsx") Then
        Exit For
    Else
        Set bookList = Workbooks.Open(everyObj)
        Range("A2:IV" & Range("A100000").End(xlUp).Row).Copy
        'Workbooks("Master.xlsx").Sheets("Master").Activate

       'Here ia tryed to use "Wokrbooks(Filename)... or Wokrbooks(Filename & ".xlsx")... but no success

        Workbooks(3).Sheets("Master").Activate 'this is the line with error, this is where i need to activate the newly created workbook
    End If
    
    Range("A300000").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    
    bookList.Close

Next
Application.ScreenUpdating = True
Range("A1").Select
Resumo

ActiveWorkbook.Save

Range("A2:p2").Select
Range(Selection, Selection.End(xlDown)).Copy

End Sub

 

[Rosen]

Here is a way to directly reference the newly created workbook, please note I've not tested the new code so it would be a good idea to backup your work before testing it out.

Sub MesclarArquivos()

Dim bookList As Workbook, Book As Workbook
Dim FolderPath As String, FileName As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
With Application.FileDialog(4)
   .AllowMultiSelect = False
   If .Show Then
      FolderPath = .SelectedItems(1)
   Else
      Exit Sub
   End If
End With

Set dirObj = mergeObj.Getfolder(FolderPath & "\")

FileName = FolderPath & "\Master - " & Format(Now(), "dd-mm-yy - hh-mm")
'FileName = FolderPath & "\Master.xlsx"

If Dir(FileName) = "" Then
    Set Book = Workbooks.Add
    Book.SaveAs FileName:=FolderPath & "\Master - " & Format(Now(), "dd-mm-yy - hh-mm")
'    Workbooks.Add.SaveAs FileName:=FolderPath & "\Master - " & Format(Now(), "dd-mm-yy - hh-mm")
'    Workbooks.Add.SaveAs FileName:=FolderPath & "\Master.xlsx"
    Sheets("planilha1").Name = "Master"
Else
    MsgBox "O arquivo já existe na pasta.", vbInformation
    Exit Sub
End If

Set filesObj = dirObj.Files


For Each everyObj In filesObj
       
    If everyObj = (FileName & ".xlsx") Then
        Exit For
    Else
        Set bookList = Workbooks.Open(everyObj)
        Range("A2:IV" & Range("A100000").End(xlUp).Row).Copy
        'Workbooks("Master.xlsx").Sheets("Master").Activate

       'Here ia tryed to use "Wokrbooks(Filename)... or Wokrbooks(Filename & ".xlsx")... but no success

        Book.Sheets("Master").Activate
'        Workbooks(3).Sheets("Master").Activate 'this is the line with error, this is where i need to activate the newly created workbook
    End If
   
    Range("A300000").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
   
    bookList.Close

Next
Application.ScreenUpdating = True
Range("A1").Select
Resumo

ActiveWorkbook.Save

Range("A2:p2").Select
Range(Selection, Selection.End(xlDown)).Copy

End Sub

 

[Ulisses_Carso]

Hi Rosen,

I didn't think it would work that way but it worked perfectly, thank you very much!!

 

[Rosen]

Glad I could help