Помогите, как заставить открывать файлы поочередно по возростанию имени?[spoiler][/spoiler]
задача кода такова - открыть файл с именем П-1-КБ2.xls, перенести данные в файл КБ3.xls, закрыть П-1-КБ2.xls, открыть следующий файл П-2-КБ2.xls и по кругу.
проблема в том, что excel открывает файлы не по очереди а хаотично - П-1-КБ2.xls, П-100-КБ2.xls, П-101-КБ2.xls, П-2-КБ2.xls, П-200-КБ2.xls, П-3-КБ2.xls.
вот код и папку с файлами прикрепил. Помогите, уже мозги кипят, а понять как так получилось не могу.
я только учусь, не судите строго.
папку с файлами прикрепил
задача кода такова - открыть файл с именем П-1-КБ2.xls, перенести данные в файл КБ3.xls, закрыть П-1-КБ2.xls, открыть следующий файл П-2-КБ2.xls и по кругу.
проблема в том, что excel открывает файлы не по очереди а хаотично - П-1-КБ2.xls, П-100-КБ2.xls, П-101-КБ2.xls, П-2-КБ2.xls, П-200-КБ2.xls, П-3-КБ2.xls.
вот код и папку с файлами прикрепил. Помогите, уже мозги кипят, а понять как так получилось не могу.
я только учусь, не судите строго.
Код |
---|
Sub КБ3() Application.ScreenUpdating = False Set wb1 = Application.ActiveWorkbook Dim i As Integer i = 1 Dim sFolder As String, sFiles As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) sFiles = Dir(sFolder & "*КБ2.xls") Do While sFiles <> "" Workbooks.Open sFolder & sFiles Set wb2 = Application.ActiveWorkbook wb1.Sheets(1).Cells(i, 1) = wb2.Sheets(1).Cells(1, 1) wb1.Sheets(1).Cells(i, 2) = wb2.Sheets(1).Cells(1, 2) i = i + 1 wb2.Activate ActiveWorkbook.Close False sFiles = Dir Loop Application.ScreenUpdating = True End Sub |