Try this untested code
Option Explicit
Private Sub btnPopulate_Click()
Dim sPath As String, fileName As String, i As Integer, x As Byte, sExt As String
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
sPath = "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(sPath)
Application.ScreenUpdating = False
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files
sExt = Right$(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, "."))
x = InStr(sExt, "xl")
If x Then
If Left(oFile.Name, 4) = "9876" Then
i = i + 1
Cells(i, 1) = fileName
End If
End If
Next oFile
Loop
Application.ScreenUpdating = True
End Sub