Merging workbooks activated via a Ribbon-Button

[Luin29]

Good evening,

Currently I have been trying to write a Macro, activated via a ribbon-button, that will merge a series of excel workbooks into one worksheet. I have performed some research and the code presented below is what I have so far (which works as a macro within a workbook):

Function simpleXlsMerger()


On Error GoTo Terminate

Dim diaFolder As FileDialog
Dim strWSName As String
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
MsgBox "Select the folder containing the excel files to be combined"
diaFolder.Show
strWSName = diaFolder.SelectedItems(1)


Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
Set dirObj = mergeObj.GetFolder(strWSName)
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
 

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next


Dim MyRange As Range
Dim MyCell As Range
Rows("1:1").EntireRow.Delete
Set MyRange = Range(Range("A2").End(xlToRight), Range("A2").End(xlDown))
For Each MyCell In MyRange
    If Not IsEmpty(MyCell) Then
        If WorksheetFunction.CountIf(MyRange, MyCell) > 1 Then
        MyCell.EntireRow.Hidden = True
        Else
        MyCell.EntireRow.Hidden = False
        End If
    End If
Next MyCell
Range(Range("A1").End(xlToRight), Range("A1").End(xlDown)).EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True


Exit Function
Terminate:
    MsgBox "You've had a fatal error"
End Function

When I save the marco to my personal marco workbook and assign the marco to a ribbon-button, the code errors when it tries to switch between workbooks (ThisWorkBook,Worksheets(1).Activate)

Any help would be greatly appreciated.

Thanks

 

[mrmmickle1]

Try changing the line your referenced to:

ActiveWorkbook.Worksheets(1).Activate

You're probably going to want to change your Function to a Sub Procedure as well. To do this simply change the First Line from this:

Function simpleXlsMerger()

to this:

Sub simpleXlsMerger()

The End Function and Exit Function Statements will be updated automatically.


The main difference between a VBA Function procedure and a Sub procedure is that a Function procedure returns a result (like a value), whereas a Sub procedure does not.

 

[Luin29]

Thanks mrmmickle1. I changed my Function to a Sub and included a macro that creates a new workbook and reference the new workbook in my problem section.

Dim wbNew As Workbook
Dim vFilename As Variant
Dim nFilename As String
    Set wbNew = Workbooks.Add
        vFilename = Application.GetSaveAsFilename(fileFilter:="Microsoft Excel file (*.xls), *.xls")
    wbNew.SaveAs Filename:=vFilename
    nFilename = ActiveWorkbook.Name
.
.
.
Workbooks(nFilename).Activate

Thanks again

 

[mrmmickle1]

Glad I was able to assist. Don't hesitate to ask if you need more help.