指定条件フォルダ内の指定ファイルの自動コピーをしたいです。

お試し下さい。

Option Explicit

Dim objRecSet
Dim objFileSys
Dim objFolder
Dim objSubFolder
Dim objSubFolders
Dim strPath
Dim intCnt
Dim intNFiles
Dim strFileName
Dim strFNSorted

Const INT_N_FILES = 10 ' スキップするファイル数
Const STR_PATH_SRC = "C:\XXXXX" ' コピー元 親フォルダ
Const STR_PATH_DST = "C:\YYYYY" ' コピー先 親フォルダ

Const AD_VAR_CHAR = 200 ' adVarChar, ADO DataTypeEnum

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSys.GetFolder(STR_PATH_SRC)
Set objSubFolders = objFolder.SubFolders

For Each objSubFolder In objSubFolders
  intNFiles = objSubFolder.Files.Count
  If objSubFolder.Files.Count > INT_N_FILES Then
    strPath = STR_PATH_DST & "\" & objSubFolder.Name
    If Not objFileSys.FolderExists(strPath) Then
      objFileSys.CreateFolder(strPath)
    End If
    Set objRecSet = CreateObject("ADODB.Recordset")
    Call objRecSet.Fields.Append("FileName", AD_VAR_CHAR, 255)
    Call objRecSet.Open()
    For Each strFileName In objSubFolder.Files
      Call objRecSet.AddNew()
      objRecSet.Fields("FileName").Value = strFileName.Name
    Next
    Call objRecSet.Update()
    objRecSet.Sort = "FileName ASC"
    strFNSorted = objRecSet.GetRows()
    Call objRecSet.Close()
    Set objRecSet = Nothing
    For intCnt = INT_N_FILES To intNFiles - 1
      Call objFileSys.CopyFile(objSubFolder & "\" & strFNSorted(0, intCnt), strPath & "\" & strFNSorted(0, intCnt), True)
    Next
  End If
Next

MsgBox "処理を終了しました。", vbOkOnly + vbInformation, "終了"