Hi Mahen
Found this post on the internet which seems to work. I have posted as is:

VBA to Amalgamate Worksheets


Hi there,
If you select Tools > Macro > Visual Basic Editor and paste this code in, then hit the play button you'll end up with all of your data on one tab.
Notes:
You need to insert a new worksheet at the *front* of the workbook to receive the data.
This sheet should have values in cells B1 & B2 - it doesn't matter what you put in.
Replace n below with the number of worksheets in your workbook.
Caveat:
Assumes you have a header row on each sheet. If you have no headers replace "R2C1" with "R1C1" below.
Sub amalgamate_tabs()

Dim intRowNumber, intNewRowNumber, intSheetNumber As Integer

intSheetNumber = 2
For i = 1 To n 'The number of sheets with data 'Activate the data sheet
ActiveWorkbook.Worksheets(intSheetNumber).Activate

'Goto cell a1
Application.Goto Reference:="R2C1" 'Replace this if you have no header row

'Select all of the data on the sheet and copy
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy

'Move to the receiving worksheet
ActiveWorkbook.Worksheets(1).Activate

'Goto the first data cell in the receiving sheet
Application.Goto Reference:="R1C2"

'Find the number of the last completed row in the receiving sheet
'and assign this to intRowNumber
intRowNumber = Range("b1").End(xlDown).Row

'Increase intRowNumber by 1 to reference the first blank row
intRowNumber = intRowNumber + 1

'Move to the first blank row
Range("b" & intRowNumber).Select

'Paste in the data
ActiveSheet.Paste



'Add in the sheet name to allow tracking back in case of problems
Range("a" & intRowNumber).Select
Range("a" & intRowNumber).Value = ActiveWorkbook.Worksheets(intSheetNumber).Name

'Autofill to populate the sheet name down the range

'Find the new number of rows in the spreadsheet
intNewRowNumber = Range("b2").End(xlDown).Row

'Check that there is more than 1 row to fill
If intRowNumber - intNewRowNumber <> 0 Then

'If there is then autofill the range
Range("a" & intRowNumber).Select
Selection.AutoFill Destination:=Range("a" & intRowNumber & ":" & "a" & intNewRowNumber)

Else

'No need to fill
End If

'Increase the counter to reference the next sheet
intSheetNumber = intSheetNumber + 1

Next i

ActiveWorkbook.Worksheets(1).Name = "All Data"

End Sub