Complicated (I think) Macro

Option Explicit
Sub FsoCycleThroughFiles()
Dim Foldername As String, Cnt As Integer
Dim Filename As Object, FSO As Object
On Error GoTo ErrorHandler
Foldername = "C:\testpf\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Filename In FSO.getfolder(Foldername).Files
'**change file extension to suit
If Right(Filename.Name, 3) = "xls" Then
Workbooks.Open (Filename)
Cnt = Cnt + 1
ThisWorkbook.Sheets("Sheet1").Cells(Cnt, 1) = _
  ActiveWorkbook.Sheets("Sheet1").Range("B" & 1).Value
ActiveWorkbook.Close savechanges:=False
End If
Next Filename
Set FSO = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done"
Exit Sub

ErrorHandler:
MsgBox "An error occurred"
End Sub

Public Sub Main()


    Dim vFolder As Variant
    Dim vFile As Variant
    Dim colFiles As Collection
    Dim wrkBk As Workbook
    Dim lcol As Long
    Dim rng As Range
    
    'Ask for the folder location.
    vFolder = GetFolder()
    
    
    If vFolder <> "" Then
    
        'Get all Excel files from within folder.
        Set colFiles = New Collection
        EnumerateFiles vFolder, "*.xls*", colFiles
        
        For Each vFile In colFiles
            
            'Open the workbook without updating links.
            Set wrkBk = Workbooks.Open(CStr(vFile), False)
            
            'This is the workbook that this code is in.
            With ThisWorkbook.Worksheets("Sheet1")
            
                'Figure out where the last column on row 2 is.
                On Error Resume Next
                lcol = .Rows(2).Find("*", , , , xlByRows, xlPrevious).Column
                On Error GoTo 0
                If lcol = 0 Then
                    lcol = 1
                Else
                    lcol = lcol + 1
                End If
                
                'Paste data from B2 into the last cell.
                .Cells(2, lcol) = wrkBk.Worksheets(1).Cells(2, 2)
            End With
            
            'Close the workbook without saving.
            wrkBk.Close False
        Next vFile
    End If


End Sub


'---------------------------------------------------------------------------------------
' Procedure : GetFolder
' Purpose   : Returns the file path of the selected folder.
' To Use    : vFolder = GetFolder()
'           : vFolder = GetFolder("S:\Bartrup-CookD\Customer Services Phone Reports")
'---------------------------------------------------------------------------------------
Function GetFolder(Optional startFolder As Variant = -1) As Variant
    Dim fldr As FileDialog
    Dim vItem As Variant
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If startFolder = -1 Then
            .InitialFileName = Application.DefaultFilePath
        Else
            If Right(startFolder, 1) <> "\" Then
                .InitialFileName = startFolder & "\"
            Else
                .InitialFileName = startFolder
            End If
        End If
        If .Show <> -1 Then GoTo NextCode
        vItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = vItem
    Set fldr = Nothing
End Function


'----------------------------------------------------------------------------------
' Procedure : EnumerateFiles
' Purpose   : Places all file names with FileSpec extension into a collection.
' To Use    : EnumerateFiles "S:\Bartrup-CookD\Trackers", "*.xls", colFiles
'-----------------------------------------------------------------------------------
Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)


    Dim sTemp As String
    
    If InStrRev(sDirectory, "\") <> Len(sDirectory) Then
        sDirectory = sDirectory & "\"
    End If
    
    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
End Sub

lcol = .Rows(2).Find("*", , , , xlByRows, xlPrevious).Column

lcol = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row

.Cells(2, lcol) = wrkBk.Worksheets(1).Cells(2, 2)

.Cells(lcol, 1) = wrkBk.Worksheets(1).Cells(2, 2)

ThisWorkbook.Worksheets("Sheet1").Cells.ClearContents