mancubus, I want to again thank you for your help. I have found the solution to my problems and have the vba running to my requirements, mostly thanks to you.

Cheers.

SOLUTION:

[vba]Option Explicit
Sub Generate_Report()
'http://vbaexpress.com/forum/showthread.php?t=39367
'requires a reference to Microsoft Scripting Runtime

Dim fso As Object, fsoFolder As Object, fsoSubfolder As Object
Dim wbMaster As Workbook, wbData As Workbook, wsMaster As Worksheet
Dim folderPath As String, subfolderName As String, wbMasterName As String
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long


With Application
.ScreenUpdating = True
.EnableEvents = False
.DisplayAlerts = False
End With

Set fso = CreateObject("Scripting.FileSystemObject")
folderPath = "\" 'change this to your folder path
Set fsoFolder = fso.GetFolder(folderPath)

wbMasterName = "Reports.xlsx"
Set wbMaster = Workbooks.Open(folderPath & "\" & wbMasterName)


With wbMaster
For Each fsoSubfolder In fsoFolder.SubFolders
subfolderName = fsoSubfolder.Name
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = subfolderName
Set wsMaster = ActiveSheet
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.Cells.Clear
NR = 1
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If
'Path and filename (edit this section to suit)
fPath = folderPath & "\" & subfolderName & "\" 'remember final \ in this string


fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file
'This is the section to customize, replace with your own action code as needed
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
If NR = 1 Then 'copy the data AND titles
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
Else 'copy the data only
Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)
End If
wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
fName = Dir 'ready next filename
End If
Loop
End With
Next
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With

End Sub


Function IsWbOpen(wbName As String) As Boolean
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=443

Dim i As Long
For i = Workbooks.Count To 1 Step -1
If Workbooks(i).Name = wbName Then Exit For
Next
If i <> 0 Then IsWbOpen = True

End Function[/vba]