<div>
How about adapting something like this? 

<pre><code class="code-10 nolinks" id="code-20-42080381-1">Sub CopyAllWorkbooks()
 Dim wkbkDestination As Workbook, wkbkSource As Workbook
 Dim currentWorksheet As Worksheet

 ' you need to either already have desination.xls or create it new using code (workbooks.add, etc)
 Workbooks.Open Filename:=&quot;C:\temp\Desination.xls&quot;
 Set wkbkDestination = ActiveWorkbook

 ' you would need to loop through an array of file names here and repeat the below process for each
 Workbooks.Open Filename:=&quot;C:\TestFolder\Original.xls&quot;
 Set wkbkSource = ActiveWorkbook

 For Each currentWorksheet In wkbkSource.Sheets
 currentWorksheet.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
 Next sh
End Sub
</code></pre>
 
Hope this helps you get started.
</div>

<div>
Thank-you for your suggestions. 
How do I loop through an array of filenames in a specific order? Each workbook has the same identical multiple sheets but can contain different number of records so the ranges will vary. 
 
These are the workbook names to append. I have 14 in total. 
First one is ADSL.xlsx, second is ADAE.xlsx, and then the rest are in alphabetical order (ADCM, ADEFF, ADEX, etc.).
</div>

<div>
Why suggest creating a .xls when the other files are obviously .xlsx? I don't think the files can be opened &nbsp;in that specific order. I would suggest that you append all the worksheets into a master workbook, then sort each sheet by dataset. 
 
Step 1 would be to have a master workbok with each sheet and it's respective headings. This workbook would contain the code. 
 
Where ould the fourteen workbooks be stored. I would suggest a subfolder called Data in the folder that contains the master workbook. 
 
This is some basic code that I use for such tasks. &nbsp;It would need adapting, mainly to loop through each sheet within each workbook. The operation will not be fast because of the number of sheets and workbooks. 
 
 

<pre><code class="code-10 nolinks" id="code-20-42080490-1">'---------------------------------------------------------------------------------------
' Module : Data
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 19/11/2011
' Purpose : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.
 
'---------------------------------------------------------------------------------------



Sub CombineData()
 Dim oWbk As Workbook
 Dim rRng As Range
 Dim rToCopy As Range
 Dim rNextCl As Range
 Dim lCount As Long
 Dim bHeaders As Boolean
 Dim sFil As String
 Dim sPath As String

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .EnableEvents = False
 ' On Error GoTo exithandler
 ' assumes workbooks are in a sub folder named &quot;Data&quot;
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator &amp; &quot;Data&quot;
 ChDir sPath
 sFil = Dir(&quot;*.xl**&quot;) 'file type
 Do While sFil &lt;&gt; &quot;&quot; 'will start LOOP until all files in folder sPath have been looped through

 With ThisWorkbook.Worksheets(1)
 Set rRng = .Range(&quot;A1&quot;).CurrentRegion ''//change range here
 If rRng.Cells.Count = 0 Then
 'no data in master sheet
 bHeaders = False
 Else: bHeaders = True
 End If

 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil) 'opens the file
 'A1 must be within the data, if not amend the Range below
 Set rToCopy = oWbk.ActiveSheet.Range(&quot;A1&quot;).CurrentRegion
 If Not bHeaders Then
 Set rNextCl = .Cells(1, 1)
 bHeaders = True
 Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
 'headers exist so don't copy
 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 End If
 rToCopy.Copy rNextCl
 End With
 oWbk.Close False 'close source workbook
 sFil = Dir
 Loop ' End of LOOP
 
exithandler:
 .ScreenUpdating = True
 .DisplayAlerts = True
 .EnableEvents = True
 End With
End Sub
</code></pre>
 
Let me know if this sounds right and I'll adapt my code.
</div>

<div>
Thanks Roy! 
It does loop through each workbook but it appends all the data onto the first sheet of the final workbook. 
Can it append the data to each sheet? There are 12 sheets in each workbook that are identical but contain different number of records.
</div>

<div>
Roy's feeling a little feisty today. &nbsp;XLS or XLSX, same processes apply. &nbsp;No reason to be aggressive about it or confuse the OP with your irrelevant complaint. &nbsp;I'm not interested in an argument here - I was just trying to be helpful &lt;/rant&gt; 
 
I hope Roy's code does what you want. &nbsp;As he pointed out, it will be slow and requires looping through the contents of each sheet in each worksheet. &nbsp;It will work in concept, but is an inefficient way of doing what you want. 
 
You asked to copy sheets from one workbook to another and that's what my code does. 
 
You could create an array of the workbook names that you want to copy from, something like: 
 

<pre><code class="code-1 nolinks" id="code-20-42080643-1">Dim FileNameArray(14) As String
FileNameArray(0) = &quot;filename1.xlsx&quot;
FileNameArray(1) = &quot;filename2.xlsx&quot;
...
FileNameArray(13) = &quot;filename13.xlsx&quot;
</code></pre>
 
then use i as a counter and loop 
 

<pre><code class="code-10 nolinks" id="code-20-42080643-2">Sub CopyAllWorkbooks()
 Dim wkbkDestination As Workbook, wkbkSource As Workbook
 Dim currentWorksheet As Worksheet

 dim i as Integer

	Dim FileNameArray(14) As String
	FileNameArray(0) = &quot;filename1.xlsx&quot;
	FileNameArray(1) = &quot;filename2.xlsx&quot;
	...
	FileNameArray(13) = &quot;filename13.xlsx&quot;

 ' you need to either already have desination.xls or create it new using code (workbooks.add, etc)
 Workbooks.Open Filename:=&quot;C:\temp\Desination.xls&quot;
 Set wkbkDestination = ActiveWorkbook

 for i = 0 to 13


	 Workbooks.Open Filename:=&quot;C:\TestFolder\&quot; &amp; FileNameArray(i)
	 Set wkbkSource = ActiveWorkbook

	 For Each currentWorksheet In wkbkSource.Sheets
		 currentWorksheet.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
	 Next currentWorksheet
	next i
End Sub
</code></pre>
 
This code will work no matter how many worksheets are in each file and no matter what the content is. &nbsp;It'll just copy all worksheets to your master file. &nbsp;Create the master file (xls or xlsx !!!) by hand and put the filename in the code or write code to create a new file and save it. &nbsp;I'll leave that simple task to you. 
 
 
FYI - if this is a homework assignment, I hope you can learn from this code. &nbsp;If it's not a homework assignment and is to be used in some sort of professional capacity, good luck.
</div>

<div>
Thanks again Weinberk. 
 
The code above works to copy each sheet to the master file. What I need is a way to append/stack the workbooks onto each other. The name of the worksheets in each .xlsx file are the same but contain different data. 
 
Thank-you for the above code as it will come handy for another time and I'm learning from your code. 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154970/adsl.xlsx" target="_blank" class="file-inline" title="First workbook (136 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adsl.xlsx</a> 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154971/adae.xlsx" target="_blank" class="file-inline" title="Second workbook to stack/append (153 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adae.xlsx</a> 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154973/adcm.xlsx" target="_blank" class="file-inline" title="Third workbook to stack/append (191 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adcm.xlsx</a>
</div>

adcm.xlsx

adae.xlsx

adsl.xlsx

<div>
I misunderstood that important point in your original request. &nbsp; 
 
The method I suggested will definitely not work for that. &nbsp;However, you could combine what I suggested with part of Roy's concept. &nbsp; 
 
Loop through the array of known workbook file names. &nbsp;When you hit a sheet, see if that sheet exists in the master file. &nbsp;If it doesn't, simply copy it as my code already does. &nbsp;If it does already exist, find the last row of data in the master file, then find the last row of data in the current worksheet. &nbsp;Copy A2 of the current worksheet to the last column last row of the worksheeet. &nbsp;I strongly recommend coding this yourself. &nbsp;It's not terribly complicated, but will require a bit of thought and will be a good learning exercise.
</div>

<div>
It needs amending for you. Now I know that it what you want I'll add the extra code.
</div>

<div>
Thank-you Roy. Much appreciated.
</div>

<div>
FYI, a couple minutes away from a complete solution here too.
</div>

<div>
This works in my testing: 
 

<pre><code class="code-100 nolinks" id="code-20-42082179-1">Option Explicit

' relatively efficient way of returning last row in a sheet
Function ReturnLastRow(wkshtCurrent As Worksheet) As Long
 ReturnLastRow = wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function

' relatively efficient way of returning last column in a sheet
Function ReturnLastColumn(wkshtCurrent As Worksheet) As String
 ReturnLastColumn = ColumnLetter(wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column)
End Function

Function ColumnLetter(ColumnNumber As Long) As String
 Dim n As Long
 Dim c As Byte
 Dim s As String

 n = ColumnNumber
 Do
 c = ((n - 1) Mod 26)
 s = Chr(c + 65) &amp; s
 n = (n - c) \ 26
 Loop While n &gt; 0
 ColumnLetter = s
End Function

Function DoesWorksheetExist(sSheetname As String, wkbkCurrent As Workbook) As Boolean
 Dim wkshtCurrent As Worksheet
 
 DoesWorksheetExist = False
 For Each wkshtCurrent In wkbkCurrent.Worksheets
 If wkshtCurrent.Name = sSheetname Then
 DoesWorksheetExist = True
 Exit Function
 End If
 Next wkshtCurrent
 

End Function

 
Function CopyAllWorkbooks()
 Dim wkbkDestination As Workbook, wkbkSource As Workbook
 Dim wkshtCurrent As Worksheet
 Dim sCurrentSourceFilename As String
 Dim sSourceFolderName As String

 ' comment this out if debugging
 Application.ScreenUpdating = False
 
 sSourceFolderName = &quot;d:\temp\EE Help\Sources\&quot;
 
 ' assuming macro is running from desination workbook
 Set wkbkDestination = ActiveWorkbook

 ' Get all xlsx files in the sources folder
 ' Assumes that all xlsx files in the source folder are to be used and that
 ' the desination file is NOT in the sources folder
 sCurrentSourceFilename = Dir(sSourceFolderName &amp; &quot;*.xlsx&quot;)
 
 ' loop through all source files
 Do While (sCurrentSourceFilename &lt;&gt; &quot;&quot;)
 
 Workbooks.Open Filename:=sSourceFolderName &amp; sCurrentSourceFilename
 Set wkbkSource = ActiveWorkbook

 

 For Each wkshtCurrent In wkbkSource.Sheets
 
 
 ' if the worksheet already exists in the desination
 If DoesWorksheetExist(wkshtCurrent.Name, wkbkDestination) Then
 
 ' these files have named ranges which conflict, just ignorge the warning
 Application.DisplayAlerts = False
 
 ' copy source range staring A2 to last row/column to destination last row + 1
 
 If ReturnLastRow(wkshtCurrent) &gt; 1 Then ' don't bother if last row is 1, that's a header row, avoids duplicate header rows
 wkshtCurrent.Range(&quot;A2:&quot; &amp; ReturnLastColumn(wkshtCurrent) &amp; ReturnLastRow(wkshtCurrent)).Copy _
 Destination:=wkbkDestination.Sheets(wkshtCurrent.Name).Range(&quot;A&quot; &amp; _
 (ReturnLastRow(wkbkDestination.Sheets(wkshtCurrent.Name)) + 1))
 End If
 Application.DisplayAlerts = True
 
 
 
 ' sheet doesn't alrady exist, just copy the whole sheet
 Else
 wkshtCurrent.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
 End If
 Next wkshtCurrent
 wkbkSource.Close False
 
 ' get next matching file, if any
 sCurrentSourceFilename = Dir
 Loop
 
 Application.ScreenUpdating = True
 
End Function
</code></pre>
 
You've got some named ranges which can't be duplicated in the new master. &nbsp;Only the last file's ranges will be preserved. &nbsp;Alternatively, you can write code to rename the ranges. &nbsp;Don't get me wrong, all of the data is there, just the shortcut names are lost. 
 
Let me know if you have questions.
</div>

<div>
Hi 
 
I've amended the code to work through each worksheet. 
 
The data sheets should be in a sub folder of the folder containing the master sheet 
 
I don't think you want to copy this sheet - &quot;NRFD_NameList&quot;. 
 
Let me know if it needs any changes. 
 

<pre><code class="code-10 nolinks" id="code-20-42082184-1">Option Explicit

'---------------------------------------------------------------------------------------
' Module : Data
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 19/11/2011
' Purpose : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.

'---------------------------------------------------------------------------------------



Sub CombineData()
 Dim oWbk As Workbook, oWs As Worksheet
 Dim rRng As Range, rToCopy As Range, rNextCl As Range
 Dim lCount As Long
 Dim bHeaders As Boolean
 Dim sFil As String, sPath As String

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .EnableEvents = False
 ' On Error GoTo exithandler
 ' assumes workbooks are in a sub folder named &quot;Data&quot;
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator &amp; &quot;Data&quot;
 ChDir sPath
 sFil = Dir(&quot;*.xl**&quot;) 'file type
 Do While sFil &lt;&gt; &quot;&quot; 'will start LOOP until all files in folder sPath have been looped through


 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil) 'opens the file
 For Each oWs In oWbk.Worksheets
 MsgBox oWs.Name
 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 Loop ' End of LOOP

exithandler:
 .ScreenUpdating = True
 .DisplayAlerts = True
 .EnableEvents = True
 End With
End Sub

Function WksExists(wksName As String) As Boolean
 On Error Resume Next
 WksExists = CBool(Len(ThisWorkbook.Worksheets(wksName).Name) &gt; 0)
End Function
</code></pre>
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1155129/adae.xlsm" target="_blank" class="file-inline" title="adae.xlsm (147 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adae.xlsm</a>
</div>

adae.xlsm

<div>
Both solutions work great! 
 
One last thing. I need to be able to append the .xlsx files in a specific order. ADSL.xlsx, ADAE.xlsx, ADCM.xlsx and then alphabetically after that (ADEFF, ADEX, etc.) 
Is that possible? 
 
Roy, how do I turn off the box that appears for each worksheet ('Datasets' button with 'OK')? There are 14 .xlsx files and 12 worksheets so many boxes are appearing. 
 
Many thanks! 
Tracy
</div>

<div>
Sorry, I forgot to remove that. I was using it to test that all sheets were copied. 

<pre><code class="code-10 nolinks" id="code-20-42083035-1">Option Explicit

'---------------------------------------------------------------------------------------
' Module : Data
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 19/11/2011
' Purpose : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.

'---------------------------------------------------------------------------------------



Sub CombineData()
 Dim oWbk As Workbook, oWs As Worksheet
 Dim rRng As Range, rToCopy As Range, rNextCl As Range
 Dim lCount As Long
 Dim bHeaders As Boolean
 Dim sFil As String, sPath As String

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .EnableEvents = False
 ' On Error GoTo exithandler
 ' assumes workbooks are in a sub folder named &quot;Data&quot;
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator &amp; &quot;Data&quot;
 ChDir sPath
 sFil = Dir(&quot;*.xl**&quot;) 'file type
 Do While sFil &lt;&gt; &quot;&quot; 'will start LOOP until all files in folder sPath have been looped through


 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil) 'opens the file
 For Each oWs In oWbk.Worksheets
 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 Loop ' End of LOOP

exithandler:
 .ScreenUpdating = True
 .DisplayAlerts = True
 .EnableEvents = True
 End With
End Sub

Function WksExists(wksName As String) As Boolean
 On Error Resume Next
 WksExists = CBool(Len(ThisWorkbook.Worksheets(wksName).Name) &gt; 0)
End Function
</code></pre>
 
As I said before I don't think that you can open the workbooks in that order. Maybe the first two workbooks can be opened by name then run the loop.
</div>

<div>
If I think of a better way I'll post it later, I'm off to work soon. I haven't tested it but it should open the first two files and perform the copying. Next i will loop through the data folder as before. 
 
Firstly, move the two workbooks out of Data to the same folder as the master workbook. Then run the amended version. 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1155289/adae-v2.xlsm" target="_blank" class="file-inline" title="adae-v2.xlsm (147 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adae-v2.xlsm</a>
</div>

adae-v2.xlsm

<div>
I'll let Roy run with this. &nbsp;If you want me to modify my solution, let me know. &nbsp;No problem to open in a specific order if you always know the names of the files.
</div>

<div>
Hi Roy, the last version doesn't append all the worksheets. I get an error on the line 'SFil = Dir' line. It brings in ADSL but doesn't bring in ADAE.xlsx because of this. I tried moving the statement to the end and removing it entirely but both didn't work. 
 
Weinberk, if you have a solution that would be great! In the future, I will always have ADSL.xlsx and ADAE.xlsx files but the rest all depends. So if it can bring in the first two filenames (ADSL, ADAE) and then loop through the rest, that would be ideal. 
 
So close. Thanks again for both your help.
</div>

<div>
I'll get this done for you right now. &nbsp;Give me 20 or so.
</div>

<div>
Here you go. &nbsp;Code is commented pretty well, but if you have questions, just let me know. 
 

<pre><code class="code-100 nolinks" id="code-20-42084078-1">Option Explicit

Public wkbkDestination As Workbook, wkbkSource As Workbook
Public wkshtCurrent As Worksheet
Public sCurrentSourceFilename As String
Public sSourceFolderName As String


' relatively efficient way of returning last row in a sheet
Function ReturnLastRow(wkshtCurrent As Worksheet) As Long
 ReturnLastRow = wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function

' relatively efficient way of returning last column in a sheet
Function ReturnLastColumn(wkshtCurrent As Worksheet) As String
 ReturnLastColumn = ColumnLetter(wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column)
End Function

Function ColumnLetter(ColumnNumber As Long) As String
 Dim n As Long
 Dim c As Byte
 Dim s As String

 n = ColumnNumber
 Do
 c = ((n - 1) Mod 26)
 s = Chr(c + 65) &amp; s
 n = (n - c) \ 26
 Loop While n &gt; 0
 ColumnLetter = s
End Function

Function DoesWorksheetExist(sSheetname As String, wkbkCurrent As Workbook) As Boolean
 Dim wkshtCurrent As Worksheet
 
 DoesWorksheetExist = False
 For Each wkshtCurrent In wkbkCurrent.Worksheets
 If wkshtCurrent.Name = sSheetname Then
 DoesWorksheetExist = True
 Exit Function
 End If
 Next wkshtCurrent
 

End Function

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
 IsInArray = (UBound(Filter(arr, LCase(stringToBeFound))) &gt; -1)
End Function

Sub DoTheCopying()
 Workbooks.Open Filename:=sSourceFolderName &amp; sCurrentSourceFilename
 Set wkbkSource = ActiveWorkbook

 

 For Each wkshtCurrent In wkbkSource.Sheets
 
 
 ' if the worksheet already exists in the desination
 If DoesWorksheetExist(wkshtCurrent.Name, wkbkDestination) Then
 
 ' these files have named ranges which conflict, just ignorge the warning
 Application.DisplayAlerts = False
 
 ' copy source range staring A2 to last row/column to destination last row + 1
 
 If ReturnLastRow(wkshtCurrent) &gt; 1 Then ' don't bother if last row is 1, that's a header row, avoids duplicate header rows
 wkshtCurrent.Range(&quot;A2:&quot; &amp; ReturnLastColumn(wkshtCurrent) &amp; ReturnLastRow(wkshtCurrent)).Copy _
 Destination:=wkbkDestination.Sheets(wkshtCurrent.Name).Range(&quot;A&quot; &amp; _
 (ReturnLastRow(wkbkDestination.Sheets(wkshtCurrent.Name)) + 1))
 End If
 Application.DisplayAlerts = True
 
 
 
 ' sheet doesn't alrady exist, just copy the whole sheet
 Else
 wkshtCurrent.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
 End If
 Next wkshtCurrent
 wkbkSource.Close False
 

End Sub
 
Function CopyAllWorkbooks()

 Dim i As Integer
 Dim sArrayFirstFiles(2) As String
 sArrayFirstFiles(0) = &quot;adsl.xlsx&quot;
 sArrayFirstFiles(1) = &quot;adae.xlsx&quot;
 

 ' comment this out if debugging
 Application.ScreenUpdating = False
 
 sSourceFolderName = &quot;d:\temp\EE Help\Sources\&quot;
 
 ' assuming macro is running from desination workbook
 Set wkbkDestination = ActiveWorkbook

 ' first do the files that we've defined in the array, in order
 For i = 0 To UBound(sArrayFirstFiles) - 1
 sCurrentSourceFilename = sArrayFirstFiles(i)
 DoTheCopying
 Next i
 
 ' Get all xlsx files in the sources folder
 ' Assumes that all xlsx files in the source folder are to be used and that
 ' the desination file is NOT in the sources folder
 sCurrentSourceFilename = Dir(sSourceFolderName &amp; &quot;*.xlsx&quot;)
 
 ' loop through all source files
 Do While (sCurrentSourceFilename &lt;&gt; &quot;&quot;)
 
 ' if it's one of the files that we did first, do nothing
 If Not IsInArray(sCurrentSourceFilename, sArrayFirstFiles) Then
 DoTheCopying
 End If
 
 ' get next matching file, if any
 sCurrentSourceFilename = Dir
 
 Loop
 
 Application.ScreenUpdating = True
 
End Function
</code></pre>
</div>

<div>
Hi Weinberk, 
I get the following error when I run. 
 
Error 1004. Method of 'Open' of Object 'Workbooks' failed. 
 
Workbooks.Open Filename:=sSourceFolderName &amp;&nbsp;sCurrentSourceFilename 
 
I included all files under the 'Sources' folder.
</div>

<div>
Did I get the file names right in: 
sArrayFirstFiles(0) = &quot;adsl.xlsx&quot; 
sArrayFirstFiles(1) = &quot;adae.xlsx&quot; 
 
 
Also, the source files need to be closed first. &nbsp;Maybe try by closing excel completely to insure that any that are inadvertently opened are closed?
</div>

<div>
Thanks Weinberk. 
 
It's appending the other workbooks in alphabetical order! 
&nbsp; 
It doesn't work for filenames starting with a numeric value such as '201_ADSL.xlsx, 201_ADAE.xlsx' even though I entered those filenames into the code. Will it only work for filenames that start with a character value such as 'ADSL.xlsx'? 
 
Two hiccups in the final document. 
First is that I get an extra tab called 'Sheet 1' &nbsp;(at the very beginning). Do you? 
Second, is that ADSL and ADAE workbooks are stacked twice. So it's appending those two files twice. Does that happen for you?
</div>

<div>
I'm not in front of a system that &nbsp;can test with right now, I'll get in front of one ASAP. 
 
It's not putting the adsl and adae files first? &nbsp; 
The rest should be added alphabetically - is that not what you wanted? 
I see no reason that it wouldn't get 201_ADSL.xlsx, alphabetically before files that start with a letter, but after the fixed ADSL and ADAE files. 
 
Sheet 1 is the sheet that is created when you create a new document. &nbsp;That's an excel default. &nbsp;You can easily delete it in the new file, or do it in code 

<pre><code class="code-1 nolinks" id="code-20-42084396-1">wkbkDestination.sheets(&quot;Sheet 1&quot;).delete
</code></pre>
</div>

<div>
Yes, it's putting ADSL and ADAE first. It also appends ADSL and ADAE in alphabetical order with the others. When I tested it with '201_ADSL.xls' etc. it gave an error saying it could not find '..$201_ADSL'. The character sign, $, before the filename suggested to me that it was looking for a character value? 
 
Thanks. I will add the extra code to delete 'Sheet 1' if it occurs! 
 
Tracy
</div>

<div>
Any suggestions on where to put code to prevent the following message 'The workbook contains links to one or more external sources that could be unsafe.' I found this code but not sure where to put it or if it's the correct code. I'm getting this message 5 times during the appending process. 
 
Application.AskToUpdateLinks = False
</div>

<div>
I must have missed something in the code that checks to see if there's a match in the file name. &nbsp;I'll figure that out. 
 
Confused about what's going on with the numerical file names too. &nbsp; 
 
As for the external links warning, are some of your excel files pulling data from an external source like a database or another excel file?
</div>

<div>
I've done more testing and see nothing wrong. 
 
The &quot;The workbook contains links to one or more external sources that could be unsafe&quot; error happens if one of the data files contains, well, links to an external source. &nbsp;Is that the case? 
 
To test, I used your 3 sample files. &nbsp;I duplicated 2 of them, naming one 201_ADSL.xlsx, and another someotherfile.xlsx. &nbsp;I changed data in the study tab of each file to make it easy to see which files were being added and in which order. &nbsp;I always get ADSL and ADAE fist, and then the other files in alphabetical order. &nbsp;I do NOT get duplication of ADSL and ADAE. &nbsp; 
 
Are you sure you didn't run the code, which errored out after giving the unsafe link error and then run it again? &nbsp;If the sheets exist in the destination file, they'll be appended to. 
 
In reference to your file name that starts with 201: &nbsp;When it runs on my development system (windows 10), I have no problem with numerically named files. &nbsp;Are you editing the vba code to reference this 201 file name? &nbsp;You should have to - the code will happily suck in any file that's in the sources folder. &nbsp;The only reason for you to type the 201 file name into the code would be if you wanted to have that appear in a specific order before the alphabetized list. &nbsp;If that's the case, increase the size of the array: 
change Dim sArrayFirstFiles(2) As String 
to 
Dim sArrayFirstFiles(3) As String 
to be able to have 3 files appear in a specific order before the rest are alphabetized and add the 3rd file like this: 
sArrayFirstFiles(2) = &quot;201_file.xlsx&quot; 
 
note that arrays in vba start with 0, not 1, so the 3rd item is 2. 
 
 
Also, I just stumbled on a request to have ADCM in the fixed ordered list. &nbsp;I changed the code to do that, and added in the bit to delete sheet1. 
 
 

<pre><code class="code-100 nolinks" id="code-20-42084440-1">Option Explicit

Public wkbkDestination As Workbook, wkbkSource As Workbook
Public wkshtCurrent As Worksheet
Public sCurrentSourceFilename As String
Public sSourceFolderName As String


' relatively efficient way of returning last row in a sheet
Function ReturnLastRow(wkshtCurrent As Worksheet) As Long
 ReturnLastRow = wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function

' relatively efficient way of returning last column in a sheet
Function ReturnLastColumn(wkshtCurrent As Worksheet) As String
 ReturnLastColumn = ColumnLetter(wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column)
End Function

Function ColumnLetter(ColumnNumber As Long) As String
 Dim n As Long
 Dim c As Byte
 Dim s As String

 n = ColumnNumber
 Do
 c = ((n - 1) Mod 26)
 s = Chr(c + 65) &amp; s
 n = (n - c) \ 26
 Loop While n &gt; 0
 ColumnLetter = s
End Function

Function DoesWorksheetExist(sSheetname As String, wkbkCurrent As Workbook) As Boolean
 Dim wkshtCurrent As Worksheet
 
 DoesWorksheetExist = False
 For Each wkshtCurrent In wkbkCurrent.Worksheets
 If wkshtCurrent.Name = sSheetname Then
 DoesWorksheetExist = True
 Exit Function
 End If
 Next wkshtCurrent
 

End Function

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
 IsInArray = (UBound(Filter(arr, LCase(stringToBeFound))) &gt; -1)
End Function

Sub DoTheCopying()
 Workbooks.Open Filename:=sSourceFolderName &amp; sCurrentSourceFilename
 Set wkbkSource = ActiveWorkbook

 For Each wkshtCurrent In wkbkSource.Sheets
 
 
 ' if the worksheet already exists in the desination
 If DoesWorksheetExist(wkshtCurrent.Name, wkbkDestination) Then
 
 
 
 ' copy source range staring A2 to last row/column to destination last row + 1
 
 If ReturnLastRow(wkshtCurrent) &gt; 1 Then ' don't bother if last row is 1, that's a header row, avoids duplicate header rows
 wkshtCurrent.Range(&quot;A2:&quot; &amp; ReturnLastColumn(wkshtCurrent) &amp; ReturnLastRow(wkshtCurrent)).Copy _
 Destination:=wkbkDestination.Sheets(wkshtCurrent.Name).Range(&quot;A&quot; &amp; _
 (ReturnLastRow(wkbkDestination.Sheets(wkshtCurrent.Name)) + 1))
 End If
 
 
 ' sheet doesn't alrady exist, just copy the whole sheet
 Else
 wkshtCurrent.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
 End If
 Next wkshtCurrent
 wkbkSource.Close False
 

End Sub
 
Function CopyAllWorkbooks()

 Dim i As Integer
 Dim sArrayFirstFiles(3) As String
 sArrayFirstFiles(0) = &quot;adsl.xlsx&quot;
 sArrayFirstFiles(1) = &quot;adae.xlsx&quot;
 sArrayFirstFiles(2) = &quot;adcm.xlsx&quot;
 

 ' comment this out if debugging
 Application.ScreenUpdating = False
 
 ' these files have named ranges which conflict, just ignorge the warning
 ' also don't warn about deleting sheet 1 at the end
 Application.DisplayAlerts = False
 

 sSourceFolderName = &quot;d:\temp\EE Help\Sources\&quot;
 
 ' assuming macro is running from desination workbook
 Set wkbkDestination = ActiveWorkbook

 ' first do the files that we've defined in the array, in order
 For i = 0 To UBound(sArrayFirstFiles) - 1
 sCurrentSourceFilename = sArrayFirstFiles(i)
 DoTheCopying
 Next i
 
 ' Get all xlsx files in the sources folder
 ' Assumes that all xlsx files in the source folder are to be used and that
 ' the desination file is NOT in the sources folder
 sCurrentSourceFilename = Dir(sSourceFolderName &amp; &quot;*.xlsx&quot;)
 
 ' loop through all source files
 Do While (sCurrentSourceFilename &lt;&gt; &quot;&quot;)
 
 ' if it's one of the files that we did first, do nothing
 If Not IsInArray(sCurrentSourceFilename, sArrayFirstFiles) Then
 DoTheCopying
 End If
 
 ' get next matching file, if any
 sCurrentSourceFilename = Dir
 
 Loop
 
 wkbkDestination.Sheets(&quot;Sheet1&quot;).Delete
 
 
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 
End Function
</code></pre>
</div>

<div>
Slight modification to my code. I missed a small part 

<pre><code class="code-10 nolinks" id="code-20-42084522-1">Option Explicit

'---------------------------------------------------------------------------------------
' Module : Data
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 19/11/2011
' Purpose : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Dim oWbk As Workbook, oWs As Worksheet
Dim rRng As Range, rToCopy As Range, rNextCl As Range
Dim bHeaders As Boolean
Dim sFil As String, sPath As String

Sub ImportFirst()
 Dim iX As Integer
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator
 ChDir sPath
 For iX = 1 To 2
 sFil = sPath &amp; Choose(iX, &quot;ADSL.xlsx&quot;, &quot;ADAE.xlsx&quot;)

 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil)
 For Each oWs In oWbk.Worksheets

 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 Next iX
End Sub
Sub CombineData()

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .EnableEvents = False
 ' On Error GoTo exithandler
 ImportFirst
 ' assumes workbooks are in a sub folder named &quot;Data&quot;
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator &amp; &quot;Data&quot;
 ChDir sPath
 sFil = Dir(&quot;*.xl**&quot;) 'file type
 Do While sFil &lt;&gt; &quot;&quot; 'will start LOOP until all files in folder sPath have been looped through

 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil) 'opens the file
 Select Case oWbk.Name
 Case &quot;ADSL.xlsx&quot;, &quot;ADAE.xlsx&quot; ''/// do nothing, already imported
 Case Else
 For Each oWs In oWbk.Worksheets

 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 End Select
 Loop ' End of LOOP

exithandler:
 .ScreenUpdating = True
 .DisplayAlerts = True
 .EnableEvents = True
 End With
 End Sub

Function WksExists(wksName As String) As Boolean
 On Error Resume Next
 WksExists = CBool(Len(ThisWorkbook.Worksheets(wksName).Name) &gt; 0)
End Function
</code></pre>
</div>

<div>
Roy, 
I've &nbsp;never seen the Choose function before. I like it! 
Never too old to learn!
</div>

<div>
We always have something to learn. I often use CHOOSE in VBA in similar situations. It saves writing two identical procedures or repeating lines of code. 
 
It's also a very useful Worksheet Function.
</div>

<div>
Tracy, 
anything else we can do to wrap this up for you?
</div>

<div>
Good morning Weinberk, 
 
Possible to change the path name to the current folder of the document? 
I will have to move this around to different folders. 
 
And if possible, can it search for a string in the filenames? So it would search for 'ADSL' instead of the hardcoded filename (ADSL.xlsx, ADAE.xlsx, etc.)
</div>

<div>
Application.ActiveWorkbook.Path will give the current path of the current workbook, BUT 
 
1) This requires that workbook to have been saved. &nbsp;You'd need to put the vba code in, save it, and then run the vba. 
2) I changed the code to look to the current path of the destination folder. &nbsp;It will suck in all xlsx files. &nbsp;The destination file is likely an xlsm file so it'll be ignored, but I put an exclusion in anyway 
 

<pre><code class="code-100 nolinks" id="code-20-42088405-1">Option Explicit

Public wkbkDestination As Workbook, wkbkSource As Workbook
Public wkshtCurrent As Worksheet
Public sCurrentSourceFilename As String
Public sSourceFolderName As String
Public sDestinationFilename As String

' relatively efficient way of returning last row in a sheet
Function ReturnLastRow(wkshtCurrent As Worksheet) As Long
 ReturnLastRow = wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function

' relatively efficient way of returning last column in a sheet
Function ReturnLastColumn(wkshtCurrent As Worksheet) As String
 ReturnLastColumn = ColumnLetter(wkshtCurrent.Cells.Find(&quot;*&quot;, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column)
End Function

Function ColumnLetter(ColumnNumber As Long) As String
 Dim n As Long
 Dim c As Byte
 Dim s As String

 n = ColumnNumber
 Do
 c = ((n - 1) Mod 26)
 s = Chr(c + 65) &amp; s
 n = (n - c) \ 26
 Loop While n &gt; 0
 ColumnLetter = s
End Function

Function DoesWorksheetExist(sSheetname As String, wkbkCurrent As Workbook) As Boolean
 Dim wkshtCurrent As Worksheet
 
 DoesWorksheetExist = False
 For Each wkshtCurrent In wkbkCurrent.Worksheets
 If wkshtCurrent.Name = sSheetname Then
 DoesWorksheetExist = True
 Exit Function
 End If
 Next wkshtCurrent
 

End Function

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
 IsInArray = (UBound(Filter(arr, LCase(stringToBeFound))) &gt; -1)
End Function

Sub DoTheCopying()
 Workbooks.Open Filename:=sSourceFolderName &amp; sCurrentSourceFilename
 Set wkbkSource = ActiveWorkbook

 For Each wkshtCurrent In wkbkSource.Sheets
 
 
 ' if the worksheet already exists in the desination
 If DoesWorksheetExist(wkshtCurrent.Name, wkbkDestination) Then
 
 
 
 ' copy source range staring A2 to last row/column to destination last row + 1
 
 If ReturnLastRow(wkshtCurrent) &gt; 1 Then ' don't bother if last row is 1, that's a header row, avoids duplicate header rows
 wkshtCurrent.Range(&quot;A2:&quot; &amp; ReturnLastColumn(wkshtCurrent) &amp; ReturnLastRow(wkshtCurrent)).Copy _
 Destination:=wkbkDestination.Sheets(wkshtCurrent.Name).Range(&quot;A&quot; &amp; _
 (ReturnLastRow(wkbkDestination.Sheets(wkshtCurrent.Name)) + 1))
 End If
 
 
 ' sheet doesn't alrady exist, just copy the whole sheet
 Else
 wkshtCurrent.Copy after:=wkbkDestination.Sheets(wkbkDestination.Sheets.Count)
 End If
 Next wkshtCurrent
 wkbkSource.Close False
 

End Sub
 
Function CopyAllWorkbooks()

 Dim i As Integer
 Dim sArrayFirstFiles(3) As String
 sArrayFirstFiles(0) = &quot;adsl.xlsx&quot;
 sArrayFirstFiles(1) = &quot;adae.xlsx&quot;
 sArrayFirstFiles(2) = &quot;adcm.xlsx&quot;
 
 If Len(Application.ActiveWorkbook.Path) = 0 Then
 MsgBox &quot;You must save the destination workbook first.&quot;
 Exit Function
 End If
 
 sDestinationFilename = ActiveWorkbook.Name
 

 ' comment this out if debugging
 Application.ScreenUpdating = False
 
 ' these files have named ranges which conflict, just ignorge the warning
 ' also don't warn about deleting sheet 1 at the end
 Application.DisplayAlerts = False
 

 sSourceFolderName = Application.ActiveWorkbook.Path &amp; &quot;\&quot;
 
 ' assuming macro is running from desination workbook
 Set wkbkDestination = ActiveWorkbook

 ' first do the files that we've defined in the array, in order
 For i = 0 To UBound(sArrayFirstFiles) - 1
 sCurrentSourceFilename = sArrayFirstFiles(i)
 DoTheCopying
 Next i
 
 ' Get all xlsx files in the sources folder
 ' Assumes that all xlsx files in the source folder are to be used and that
 ' the desination file is NOT in the sources folder (not really necessary since it's an xlsm)
 sCurrentSourceFilename = Dir(sSourceFolderName &amp; &quot;*.xlsx&quot;)
 
 ' loop through all source files
 Do While (sCurrentSourceFilename &lt;&gt; &quot;&quot;)
 
 ' if it's one of the files that we did first, do nothing
 ' ad it's not the destination file
 If Not IsInArray(sCurrentSourceFilename, sArrayFirstFiles) And _
 sCurrentSourceFilename &lt;&gt; sDestinationFilename Then
 DoTheCopying
 End If
 
 ' get next matching file, if any
 sCurrentSourceFilename = Dir
 
 Loop
 
 wkbkDestination.Sheets(&quot;Sheet1&quot;).Delete
 
 
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 
End Function
</code></pre>
 
Now, if you're going to be doing this repeatedly, I'd do things a bit differently. 
I suggest having an XLSM file that prompts first for which folder you want to look in and second for the name of a (macro free) destination file. &nbsp;That way, you keep the code in one place and you can run it on any folder without copying it all over the place. &nbsp;It also creates a destination file that doesn't have the code in it - so no warnings for other users when they open the destination files.
</div>

<div>
This last version works great! 
Yes, that would be perfect. Keeping the code in one place and having the prompts. 
 
Roy, I haven't tested out your code yet. I will today. One question. Do I need to keep ADSL.xlsx and ADAE..xlsx in the folder with the .xlsm file? Or all .xlsx files in the 'Data' folder? Thank-you!
</div>

<div>
<blockquote>
Roy, I haven't tested out your code yet. I will today. One question. Do I need to keep ADSL.xlsx and ADAE..xlsx in the folder with the .xlsm file? Or all .xlsx files in the 'Data' folder? Thank-you!
</blockquote>
 
I did think at first to remove thenm, but the amended code will ignore them.
</div>

<div>
Hi Roy, 
I get an error in the following line. 
Set oWbk = Workbooks.Open(sPath &amp;&nbsp;Application.PathSeparator &amp;&nbsp;sFil) 
 
It resolves for me as 'R:\.......\R.....' etc. Looks like it concatenates the same folder name. 
 
Do you get this error? 
Thanks!
</div>

<div>
Tracy, 
 
Just out of curiosity, why do you need (or even want) &nbsp;2 solutions to this question? &nbsp;I don't care how you split up the points between Roy and me (or if you even give me any), but doesn't my last posting give you everything you asked for initially, what you modified the request to, and what I suggested in terms of making this easily repeated? &nbsp;Or if you'd prefer a different solution, that's fine, but let us know so we don't have to keep revising this code. &nbsp;Don't get me wrong, I'm more than happy to help, but I don't want effort wasted.
</div>

<div>
Try this 
 

<pre><code class="code-10 nolinks" id="code-20-42091110-1">Option Explicit

'---------------------------------------------------------------------------------------
' Module : Data
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 19/11/2011
' Purpose : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Dim oWbk As Workbook, oWs As Worksheet
Dim rRng As Range, rToCopy As Range, rNextCl As Range
Dim bHeaders As Boolean
Dim sFil As String, sPath As String

Sub ImportFirst()
 Dim iX As Integer
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator
 ChDir sPath
 For iX = 1 To 2
 sFil = sPath &amp; Choose(iX, &quot;ADSL.xlsx&quot;, &quot;ADAE.xlsx&quot;)

 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil)
 For Each oWs In oWbk.Worksheets

 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 Next iX
End Sub
Sub CombineData()

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .EnableEvents = False
 ' On Error GoTo exithandler
 ImportFirst
 sPath = &quot;&quot;
 ' assumes workbooks are in a sub folder named &quot;Data&quot;
 sPath = ThisWorkbook.Path &amp; Application.PathSeparator &amp; &quot;Data&quot;
 ChDir sPath
 sFil = Dir(&quot;*.xl**&quot;) 'file type
 Do While sFil &lt;&gt; &quot;&quot; 'will start LOOP until all files in folder sPath have been looped through

 Set oWbk = Workbooks.Open(sPath &amp; Application.PathSeparator &amp; sFil) 'opens the file
 Select Case oWbk.Name
 Case &quot;ADSL.xlsx&quot;, &quot;ADAE.xlsx&quot; ''/// do nothing, already imported
 Case Else
 For Each oWs In oWbk.Worksheets

 If WksExists(oWs.Name) And oWs.Name &lt;&gt; &quot;NRFD_NameList&quot; Then
 Set rToCopy = oWs.Range(&quot;A1&quot;).CurrentRegion
 If rToCopy.Rows.Count &gt; 2 Then
 Set rNextCl = ThisWorkbook.Worksheets(oWs.Name).Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)

 Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
 rToCopy.Columns.Count)
 rToCopy.Copy rNextCl
 End If
 End If

 Next oWs
 oWbk.Close False 'close source workbook
 sFil = Dir
 End Select
 Loop ' End of LOOP

exithandler:
 .ScreenUpdating = True
 .DisplayAlerts = True
 .EnableEvents = True
 End With
 End Sub

Function WksExists(wksName As String) As Boolean
 On Error Resume Next
 WksExists = CBool(Len(ThisWorkbook.Worksheets(wksName).Name) &gt; 0)
End Function
</code></pre>
</div>

<div>
Yes, I was wondering about that as well. I am very happy to have just one solution, one expert. 
I'm very new to VBA so it's been a great learning process for me. I don't want to waste anyone's time, that's for sure. 
Thanks to you both!
</div>

<div>
Okay, then let us know who you'd like to continue here? &nbsp; 
 
We're doing things a little bit differently, but the end result should be similar. &nbsp;Roy's code doesn't prompt for the folder and copies using a different method. &nbsp;Just out of curiosity, do you find that one set of code operates more quickly than the other? 
 
Roy, if it's you that's selected, feel free to poach whatever you want from my code to allow Tracy to have this prompt for the folder, etc.
</div>

<div>
Its not difficult to change &nbsp;my code to have a browse for folder. &nbsp;I also, don't see why two approches causes a problem.
</div>

<div>
Roy, not a problem, just unnecessary duplication of effort. &nbsp;We're accomplishing the same thing - and this isn't for some massive deployment where code optimization is critical.
</div>

<div>
<div class="content wysiwyg-content">
Dear Experts, 
 
How do I append multiple Excel workbooks (Excel 2013) with multiple sheets into a new workbook using visual basic? 
 
I have 14 workbooks with identical number of worksheets in each. 
I need to append the workbooks in a specific order. 
First one is ADSL.xlsx, second is ADAE.xlsx, and then the rest are in aphabetical order (ADCM, ADEFF, ADEX, etx.). 
All workbooks are in the same folder. 
 
I have attached the first 3 workbooks. 
 
Thank-you, 
Tracy 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154757/adsl.xlsx" target="_blank" class="file-inline" title="ADSL first file (136 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adsl.xlsx</a> 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154758/adae.xlsx" target="_blank" class="file-inline" title="ADAE second file to append (153 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adae.xlsx</a> 
<a href="https://filedb.experts-exchange.com/incoming/2017/04_w14/1154759/adcm.xlsx" target="_blank" class="file-inline" title="ADCM third file to append (191 KB)"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512"><path d="M67.508 468.467c-58.005-58.013-58.016-151.92 0-209.943l225.011-225.04c44.643-44.645 117.279-44.645 161.92 0 44.743 44.749 44.753 117.186 0 161.944l-189.465 189.49c-31.41 31.413-82.518 31.412-113.926.001-31.479-31.482-31.49-82.453 0-113.944L311.51 110.491c4.687-4.687 12.286-4.687 16.972 0l16.967 16.971c4.685 4.686 4.685 12.283 0 16.969L184.983 304.917c-12.724 12.724-12.73 33.328 0 46.058 12.696 12.697 33.356 12.699 46.054-.001l189.465-189.489c25.987-25.989 25.994-68.06.001-94.056-25.931-25.934-68.119-25.932-94.049 0l-225.01 225.039c-39.249 39.252-39.258 102.795-.001 142.057 39.285 39.29 102.885 39.287 142.162-.028A739446.174 739446.174 0 0 1 439.497 238.49c4.686-4.687 12.282-4.684 16.969.004l16.967 16.971c4.685 4.686 4.689 12.279.004 16.965a755654.128 755654.128 0 0 0-195.881 195.996c-58.034 58.092-152.004 58.093-210.048.041z"/></svg>adcm.xlsx</a>
</div>
</div>

Dear Experts,

How do I append multiple Excel workbooks (Excel 2013) with multiple sheets into a new workbook using visual basic?

I have 14 workbooks with identical number of worksheets in each. 
I need to append the workbooks in a specific order.
First one is ADSL.xlsx, second is ADAE.xlsx, and then the rest are in aphabetical order (ADCM, ADEFF, ADEX, etx.).
All workbooks are in the same folder.

I have attached the first 3 workbooks.

Thank-you,
Tracy

Append multiple Excel workbooks with multiple sheets into a new workbook

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

Microsoft Excel

VBScript (Visual Basic Scripting Edition) is an interpreted scripting language developed by Microsoft that is modeled on Visual Basic, but with some important differences. VBScript is commonly used for automating administrative and other tasks in Windows operating systems (by means of the Windows Script Host) and for server-side scripting in ASP web applications. It is also used for client-side scripting in Internet Explorer, specifically in intranet web applications.

VB Script

Microsoft Office is an integrated suite of applications that includes Outlook, Word, Excel, Access, PowerPoint, Visio and InfoPath, along with a number of tools to assist in making the individual components work together. Coding within and between the projects is done in Visual Basic for Applications, known as VBA.