0
votes

I currently have a folder called Files on my desktop that contains multiple workbooks that are all similar to one another, for example:

  • Workbook1
  • Workbook2
  • Workbook3
  • Workbook4
  • Workbook5

Each of these workbooks all contain a sheet called 'Dashboard' that are the same as one another, but they feature different data for different people.

What I would like to do is:

  • Run a macro that will import all sheets called 'Dashboard' in to the new workbook I now have open.
  • Name each imported sheet after the file it was imported from.

I have researched this, and although many solutions have been offered, the closest code I have found to doing what I require is:

Sub MergeWorkbooks()

Dim xStrPath As String
Dim xStrFName As String
Dim xWS As Worksheet
Dim xMWS As Worksheet
Dim xTWB As Workbook
Dim xStrAWBName As String
On Error Resume Next
xStrPath = "C:\Users\Me\Desktop\Files"
xStrFName = Dir(xStrPath & "*.xlsx")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xTWB = ThisWorkbook
Do While Len(xStrFName) > 0
    Workbooks.Open Filename:=xStrPath & xStrFName, ReadOnly:=True
    xStrAWBName = ActiveWorkbook.Name
    For Each xWS In ActiveWorkbook.Sheets
    xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
    Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
    xMWS.Name = xStrAWBName & "(" & xMWS.Name & ")"
    Next xWS
    Workbooks(xStrAWBName).Close
    xStrFName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

When I have tried to run this, no errors are encountered and nothing happens. Does anyone have an ideas why this may be?

Thanks in advance

1
On Error Resume Next tells VBA to ignore any errors and carry on regardless, so it's not surprising you're not seeing any errors when you run your code. Comment out that line, and then see what happens when your code runs. If you get errors, edit your question to add the error message and note the line which is highlighted when you click "Debug"Tim Williams
Thanks for the comment, although new to VBA I should have picked up on that, I did what you suggested and commented out that line, I then retested it, still no errors and nothing happened. I then introduced some errors to ensure the compiler was working and they flagged up straight away.Scott
Try xStrPath = "C:\Users\Me\Desktop\Files\" (added final backslash)Tim Williams
Wow, thanks so much, that seems to have got it working, it really helps when someone else looks things over. This does however import all sheets, do you know how I could modify it to only import the sheets from each workbook called ‘Dashboard’Scott
Although this is not what you asked for, you can check #PowerQuery out which can combine data from same worksheet from different workbooks saved in the same folder. If you are interested you can google some tutorials if still have question you can ask for help here.Terry W

1 Answers

0
votes

Untested:

Sub MergeWorkbooks()

    Dim xStrPath As String
    Dim xStrFName As String
    Dim xWS As Worksheet
    Dim xMWS As Worksheet
    Dim xTWB As Workbook, wb As Workbook
    Dim xStrAWBName As String

    xStrPath = "C:\Users\Me\Desktop\Files\" '<< add final \
    xStrFName = Dir(xStrPath & "*.xlsx")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set xTWB = ThisWorkbook 

    Do While Len(xStrFName) > 0
        Set wb = Workbooks.Open(Filename:=xStrPath & xStrFName, ReadOnly:=True) '<< get a direct reference
        'copy only the specific sheet
        wb.Worksheets("Dashboard").Copy after:=xTWB.Sheets(xTWB.Sheets.Count)
        xTWB.Sheets(xTWB.Sheets.Count).Name = Replace(xStrFName, ".xlsx", "")
        wb.Close False 'don't save
        xStrFName = Dir()
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub