MS Excel: Update respective filename in excel files available in a folder

I had a scenario of combining few excel workbooks available in a folder in to one excel file. Before combining I had to update respective filenames inside each excel workbook. To perform this follow below steps.

• Create a new excel sheet any where, say desktop
• Press Alt+F11 to open VBA screen.
• Create new module
• Insert below VBA script inside the module.
• Paste the path inside the script where your excel files available.
• Run the script. You will see respective file names updated in all excel files available in the specified folder.
• Also data from all excel sheets will be pasted in to one excel file, in which you have created module and running script.

Sub UpdateRespectiveFileNames()
Path = "D:\ExcelFiles\"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename
     For Each Sheet In ActiveWorkbook.Sheets
         With WS
            LASTROW = Range("A" & Rows.Count).End(xlUp).Row
            Columns(1).Insert
            Range("A2:A" & LASTROW) = Filename
        End With
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Save
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub