Sub stat
Workbooks.OpenText Filename:= _
"C:\stats\2013\2013-11\2013-11-11\00_00_00\DVN-stats.txt" _
, Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("A1:B26").Select
Selection.Copy
ActiveWindow.Close
Sheets("00").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Графики").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\stats\2013\2013-11\2013-11-11\статистика 2013-11-11.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Статистика собрана"
End Sub

Sub mac123()
'
' mac123 Макрос
'
'
' Call to test GetFiles function.

     Dim dctDict As New Scripting.Dictionary    'создается объект Dictionary
     Dim varItem As Variant

     ' Call non recursively, return files into Dictionary object.
     If GetFiles("D:\TMP\Evg72\", dctDict, True) Then    'заполняется объект Dyctionary: dctDict
         ' Print items in dictionary.
         For Each varItem In dctDict
             If InStr(varItem, "-stats.txt") Then
                 MsgBox varItem
                 Debug.Print varItem
             End If
         Next
     End If
'    MsgBox dctDict.Count    'Выводит кол-во файлов в "C:\"
End Sub

Function GetFiles(strPath As String, _
                   dctDict As Scripting.Dictionary, _
                   Optional blnRecursive As Boolean) As Boolean

' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.

     Dim fsoSysObj As Scripting.FileSystemObject
     Dim fdrFolder As Scripting.Folder
     Dim fdrSubFolder As Scripting.Folder
     Dim filFile As Scripting.File

     ' Return new FileSystemObject.
     Set fsoSysObj = New FileSystemObject

     On Error Resume Next
     ' Get folder.
     Set fdrFolder = fsoSysObj.GetFolder(strPath)
     If Err <> 0 Then
         ' Incorrect path.
         GetFiles = False
         GoTo GetFiles_End
     End If
     On Error GoTo 0

     ' Loop through Files collection, adding to dictionary.
     For Each filFile In fdrFolder.Files
         dctDict.Add filFile.Path, filFile.Path
         'MsgBox filFile.Path  ' Выводит сообщением имя каждого файла, встретившегося в каталоге strPath, т.е. "C:\"
     Next filFile

     ' If Recursive flag is true, call recursively.
     If blnRecursive Then
         For Each fdrSubFolder In fdrFolder.SubFolders
             GetFiles fdrSubFolder.Path, dctDict, True
         Next fdrSubFolder
     End If

     ' Return True if no error occurred.
     GetFiles = True

GetFiles_End:
     Exit Function
End Function

Workbooks.OpenText Filename:= _
"C:\stats\2013\2013-11\2013-11-11\00_00_00\DVN-stats.txt"

sheets(2).range("A" & x).Paste

sheets(format(y,"00")).range("A" & x).Paste

sheets(format(y,"00")).cells(1,x).Paste

x=x+1
y=y+1

Sub test()
Sub test()
'
' test Ìàêðîñ
'
'
' Call to test GetFiles function.

            Dim dctDict As New Scripting.Dictionary    'создается объект Dictionary
            Dim varItem As Variant
            Dim y
                    
            ' Call non recursively, return files into Dictionary object.
            If GetFiles("C:\stats\2013\2013-11\2013-11-11", dctDict, True) Then    'заполняется объект Dyctionary: dctDict
                ' Print items in dictionary.
                For Each varItem In dctDict
                 y = 6
                    If InStr(varItem, "-stats.txt") Then
                        Workbooks.OpenText Filename:= _
                varItem _
                , Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
                Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
            Range("A1:B26").Copy ThisWorkbook.Worksheets(y).Range("A1")
            ActiveWindow.Close
            Workbooks.OpenText Filename:= _
                varItem _
                , Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
                Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
            Range("B3:B26").Copy ThisWorkbook.Worksheets(y).Range("C3")
            ActiveWindow.Close
            Workbooks.OpenText Filename:= _
                varItem _
                , Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
                Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
            Range("B3:B26").Copy ThisWorkbook.Worksheets(y).Range("D3")
            ActiveWindow.Close
            Range("B3:D23").Select
            Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
                y = y + 1
                    End If
                Next
            End If
'    MsgBox dctDict.Count    'Выводит кол-во файлов в "C:\"
End Sub