Combine Workbooks and Rename imported worksheet using VBA in Excel - vba

Question

I am trying to import all the XLS files in a particular directory into one workbook. I've tried several sources for the code and the closest I've come is the one below (all the rest complained when closing the imported workbook no matter what i tried).
All I want to do now is take the text from a merged cell (C7 and D7) and rename the new worksheet to that. (there is a carriage return above the name in the cell in case this has any impact. I have no control over the source files as they're produced by an external team).
I'm afraid I have almost no ability with coding of any kind but I can normally futz things reading code from other sources but I stumped here. I've managed to get it to rename it to the source filename but I would prefer to get it from the cell text.
Cheers!
Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Temp\" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
ActiveSheet.Name = wsSrc.Range("C7").Value
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Answer 1

I would change this line:
ActiveSheet.Name = wsSrc.Range("C7").Value
to:
wbDst.Worksheets(wbDst.Worksheets.Count).Name = wsSrc.Range("C7")
This will ensure you're naming the sheet in your destination workbook, not in your source workbook, which you might end up with by using ActiveSheet
From your question in the comment about the order of your files:
(BTW - you should edit your post and put the question in there, comments can get deleted)
The order is determined by the "natural" sort order that the files are held in by the OS. I have not found any flags that can be added to the Dir() command to sort them on input.
If you need to process them in name order, I would suggest:
Create a scratch sheet in wbDst
Loop through all the files using Dir(), putting them in Range(A1:An)
i.e put the first file name in Range("A1"), the second file name in Range("A2"), etc
Sort Range(A1:An) so they are in the desired order
Loop through your now sorted Range() to do the actual processing
Delete the scratch sheet from wbDst when you're done processing
For now, comment out:
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
These are great things to have in your code, but not until everything is working properly
I would suggest changing:
If Len(strFilename) = 0 Then Exit Sub
to
If Len(strFilename) > 0 Then
Do Until...
Loop
Because, if your initial read of the directory gives you no files, you never get to your clean up code after your loop. At the moment, there's nothing really critical there, but you may modify code in the future, or use this as model for other code that will require critical clean up, and it's a good habit to be in.