Option Explicit
Sub CopyFilesFromSubFolders()
    Dim FSO    As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim SubFolder As Object
    Dim CurrentFile As Object
    FromPath = "F:\test\top\"                    '<= Change to suit
    ToPath = "F:\test\everything\"               '<= Change to suit
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each SubFolder In FSO.GetFolder(FromPath).SubFolders
        For Each CurrentFile In SubFolder.Files
            CurrentFile.Copy (FSO.BuildPath(ToPath, CurrentFile.Name))
        Next
    Next SubFolder
    Set FSO = Nothing
    Set SubFolder = Nothing
    Set CurrentFile = Nothing
    MsgBox "Done"
End Sub