Вставить имя файла в ячейку из папки + сумма данных

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставить имя файла в ячейку из папки + сумма данных (Макросы/Sub)

akaDemik

Дата: Четверг, 09.11.2017, 19:32 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Имеется часть кода
[vba]

Код

Sub IMPORT_P()
Dim srcBook
Set wb = ThisWorkbook
Set wf = WorksheetFunction

' Открыть файл
    wb.Sheets("Лист1").Range("C7:C400").Font.Color = vbBlack
Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
If oFileSystemObject.FileExists(wb.Path & "\File.xls") Then
Set srcBook = Workbooks.Open(Filename:=wb.Path & "\File.xls", ReadOnly:=True, UpdateLinks:=0)
    'Вставить
    wb.Sheets("Лист1").Range("C7") = wf.Sum(srcBook.Sheets("Data").Range("GE9,GE30"))
    wb.Sheets("Лист1").Range("C8") = wf.Sum(srcBook.Sheets("Data").Range("F9,F30"))
    wb.Sheets("Лист1").Range("C9") = wf.Sum(srcBook.Sheets("Data").Range("U9,U30"))

    wb.Sheets("Лист1").Range("C7:C9").Font.Color = vbRed
    srcBook.Close SaveChanges:=False
End If
If oFileSystemObject.FileExists(wb.Path & "\File2.xls") Then
Set srcBook = Workbooks.Open(Filename:=wb.Path & "\File2.xls", ReadOnly:=True, UpdateLinks:=0)
    'Вставить
    wb.Sheets("Лист1").Range("C10") = wf.Sum(srcBook.Sheets("Data").Range("GE9,GE30"))
    wb.Sheets("Лист1").Range("C11") = wf.Sum(srcBook.Sheets("Data").Range("F9,F30"))
    wb.Sheets("Лист1").Range("C12") = wf.Sum(srcBook.Sheets("Data").Range("U9,U30"))

    wb.Sheets("Лист1").Range("C10:C12").Font.Color = vbRed
    srcBook.Close SaveChanges:=False
End If
End Sub

[/vba]
Прошу помочь изменить его с такой задачей:
Есть папка, в ней находятся файлы *.xls, необходимо в файле с макросом создать список из названий файлов (без расширения), напротив каждого просуммировать несколько ячеек каждого из файлов. У файлов с данными одинаковая структура, то есть суммировать надо одни и те же ячейки, но в разных файлах

Имеется часть кода
[vba]

Код