Copying from Multiple Wb in 1 folder to 1 Wb

Option Explicit

Private Sub CommandButton1_Click()

Dim wbSource            As Workbook
Dim wbMasterSheet       As Worksheets
Dim sTargetSheet        As String
Dim sThisFilePath       As String
Dim sFile               As String
Dim lMaxSourceRow       As Long
Dim lMasterLastRow      As Long

   sThisFilePath = ActiveWorkbook.Path
   If (Right(sThisFilePath, 1) <> "\") Then sThisFilePath = sThisFilePath & "\"
   sFile = Dir(sThisFilePath & "*.xls*")

   sTargetSheet = "24Apr2012"
   
   Set wbMasterSheet = Workbooks("Master.xlsm").Sheets("Sheet1")
   lMasterLastRow = getItemLocation("*", wbMasterSheet.Cells)
   lMasterLastRow = lMasterLastRow + 1
   
   Do While sFile <> vbNullString
      MsgBox "The next file is " & sFile
      
      'if the next file is same as "active file" then skip the file
      If (sFile = wbMasterSheet.Parent.Name) Then GoTo Next_File
      
      'Opens the next workbook in that folder
      Set wbSource = Workbooks.Open(sThisFilePath & sFile)
      
      'Find the final row of the newly opened workbook
      lMaxSourceRow = getItemLocation("*", wbSource.Sheets(sTargetSheet).Cells)
      
      If lMaxSourceRow = 0 Then GoTo Next_File
      
      Application.CutCopyMode = False
      'Copy from A2:I(sFinalRow) from current workbook
      wbSource.Worksheets(sTargetSheet).Range("A2:I" & lMaxSourceRow).Copy
            
      With wbMasterSheet
         
         'Paste those copied cells in the first available open row
         .Cells(lMasterLastRow, 1).PasteSpecial
         Application.CutCopyMode = False
         
         'put the file name
         .Range(.Cells(lMasterLastRow, "J"), .Cells(lMasterLastRow + lMaxSourceRow - 1, "J")).Value = sFile
      End With
      
      ' increment the position market of master
      lMasterLastRow = lMasterLastRow + lMaxSourceRow
   
Next_File:
      If (sFile = wbMasterSheet.Parent.Name) Then wbSource.Close SaveChanges:=False
   
      sFile = Dir
   Loop
   Set wbSource = Nothing
   Set wbMasterSheet = Nothing
   
   MsgBox "Process Completed"
   
   Application.ScreenUpdating = True

End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function