Combine multiple workbooks to one workbook in same folder

[Muhammad Hussaan]

Hello, I have multiple workbooks in a folder along with main file Name MOM.xlsm to merge data (find code below) I am having some problem with vba code below, it works fine in my computer as path is drive E and folder is "MOM" , i want to make this macro working independent of drive E. So that i can keep in USB storage and make this file workable. Kind suggest what change i should do to make it workable. Below is the codeSub Mergemom()Dim wbk As WorkbookDim sht As WorksheetDim shtt As WorksheetDim sheetfirst As WorksheetDim sheetsecond As WorksheetDim sheetthird As WorksheetDim wbk2 As WorkbookSet wbk2 = ThisWorkbookDim Filename As StringDim Path As StringPath = "E:\MOM" 'CHANGE Folder PATHFilename = Dir(Path & "*.xlsx")'OPEN EXCEL FILESDo While Len(Filename) > 0 'IF NEXT FILE EXISTS THENSet wbk = Workbooks.Open(Path & Filename)wbk.ActivateFor Each shtt In wbk.Worksheetswbk.ActivateVar = shtt.Nameshtt.SelectRange("A2").SelectRange(Selection, Selection.End(xlToRight)).SelectRange(Selection, Selection.End(xlDown)).SelectSelection.CopyWindows("MOM.xlsm").ActivateDim lr As Integer'Var = sht.NameSheets(Var).Selectlr = wbk2.Sheets(Var).Cells(Rows.Count,1).End(xlUp).RowCells(lr + 1, 1).SelectActiveSheet.PasteNextwbk.Close TrueFilename = DirLoopEnd Sub

Sub Mergemom()
Dim wbk As Workbook
Dim sht As Worksheet
Dim shtt As Worksheet
Dim sheetfirst As Worksheet
Dim sheetsecond As Worksheet
Dim sheetthird As Worksheet
Dim wbk2 As Workbook
Set wbk2 = ThisWorkbook
Dim Filename As String
Dim Path As String
Path = "E:\MOM" 'CHANGE Folder PATH
Filename = Dir(Path & "*.xlsx")
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
  Set wbk = Workbooks.Open(Path & Filename)
  wbk.Activate
  For Each shtt In wbk.Worksheets
    wbk.Activate
    Var = shtt.Name
    shtt.Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("MOM.xlsm").Activate
    Dim lr As Integer
    'Var = sht.Name
    Sheets(Var).Select
    lr = wbk2.Sheets(Var).Cells(Rows.Count, 1).End(xlUp).Row
    Cells(lr + 1, 1).Select
    ActiveSheet.Paste
  Next
  wbk.Close True
  Filename = Dir
Loop
End Sub