Здравствуйте, с толкнулся с такой проблемой есть папка в ней около 150 файлов с разрешением .xlsx. Во всех файлах структура одинаковая, только в каждом файле в ячейках разные данные, нужно в каждый файл добавить в определенную ячейку одну формулу, адрес ячейки один и тот же во всех файлах. И можно вообще как нибудь собрать в один файл все значения изо всех файлов с этой ячейки? Пример файла прилагаю.
Здравствуйте, с толкнулся с такой проблемой есть папка в ней около 150 файлов с разрешением .xlsx. Во всех файлах структура одинаковая, только в каждом файле в ячейках разные данные, нужно в каждый файл добавить в определенную ячейку одну формулу, адрес ячейки один и тот же во всех файлах. И можно вообще как нибудь собрать в один файл все значения изо всех файлов с этой ячейки? Пример файла прилагаю.fr0st
Sub example_03() 'msoFileDialogFolderPicker Dim Fold As String, f As String, i& With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select the folder in which the files to be processed" .ButtonName = "Select": .AllowMultiSelect = False If .Show Then Fold = .SelectedItems(1) Else Exit Sub End With Application.ScreenUpdating = False If Right(Fold, 1) <> "\" Then Fold = Fold & "\" f = Dir(Fold & "*.xls*", vbNormal) i = 1 Do While f <> "" Workbooks.Open Fold & f ActiveWorkbook.Sheets(1).Range("H9").Formula = "=CountA(D2:D999)/(CountA(D2:D999)-(CountA(D2:D999)*H2))" ThisWorkbook.Sheets(1).Cells(i, 1) = ActiveWorkbook.Sheets(1).Range("H9").Value ActiveWorkbook.Close True i = i + 1 f = Dir() Loop Application.ScreenUpdating = True End Sub
Sub example_03() 'msoFileDialogFolderPicker Dim Fold As String, f As String, i& With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select the folder in which the files to be processed" .ButtonName = "Select": .AllowMultiSelect = False If .Show Then Fold = .SelectedItems(1) Else Exit Sub End With Application.ScreenUpdating = False If Right(Fold, 1) <> "\" Then Fold = Fold & "\" f = Dir(Fold & "*.xls*", vbNormal) i = 1 Do While f <> "" Workbooks.Open Fold & f ActiveWorkbook.Sheets(1).Range("H9").Formula = "=CountA(D2:D999)/(CountA(D2:D999)-(CountA(D2:D999)*H2))" ThisWorkbook.Sheets(1).Cells(i, 1) = ActiveWorkbook.Sheets(1).Range("H9").Value ActiveWorkbook.Close True i = i + 1 f = Dir() Loop Application.ScreenUpdating = True End Sub