Доброго времени суток!
Помогите пожалуйста с написанием макроса,который бы выполнял копирование значений определенных ячеек из множества файлов(имеют один вид) в один файл. Получается есть главная папка, в которой находятся подпапки, в этих подпапках находятся файлы. Из этих файлов необходимо скопировать в один файл(находится в корне главной папки -"Список.xls) значения следующих ячеек (берем первый файл и из него):
B9-G9(ячейки объединены в одну) >>>>копировать значение в A2 (файл "Список.xls");
A12-E12(ячейки объединены в одну)>>>копировать значение в B2 (файл "Список.xls");
I10-J10(ячейки объединены в одну)>>>копировать значение в C2 (файл "Список.xls");
L10-M10(ячейки объединены в одну)>>>копировать значение в D2 (файл "Список.xls");
затем из второго файла уже копируем:
B9-G9(ячейки объединены в одну) >>>>копировать значение в A3 (файл "Список.xls");
A12-E12(ячейки объединены в одну)>>>копировать значение в B3 (файл "Список.xls");
I10-J10(ячейки объединены в одну)>>>копировать значение в C3 (файл "Список.xls");
L10-M10(ячейки объединены в одну)>>>копировать значение в D3 (файл "Список.xls");
и так далее пока не скопируем из всех файлов ( их более 300 расположены по подпапкам).
Указанные ячейки не содержат формул,некоторые из них могут быть пустыми, формат при копировании не важен.
В прикрепленном архиве - пример структуры папок и образцы файлов. Пробовала с помощью макрорекодера создать макрос,получается только для открытого файла ( в программировании дуб дубом к сожалению):
Sub COPY()
Windows("образец.xls").Activate
Range("B9:G9").Select
ActiveCell.FormulaR1C1 = " Денисенко Андрей Геннадьевич"
With ActiveCell.Characters(Start:=1, Length:=29).Font
.Name = "Times New Roman"
.FontStyle = "обычный"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Windows("Список.xls").Activate
Range("A2").Select
ActiveCell.FormulaR1C1 = " Денисенко Андрей Геннадьевич"
Range("B5").Select
Windows("образец.xls").Activate
Range("A12:E12").Select
ActiveCell.FormulaR1C1 = "8918 50 30 577"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Times New Roman"
.FontStyle = "обычный"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Windows("Список.xls").Activate
Range("B2").Select
ActiveCell.FormulaR1C1 = "8918 50 30 577"
Range("B3").Select
Windows("образец.xls").Activate
Range("I10:J10").Select
ActiveCell.FormulaR1C1 = "Hyundai Accent"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Times New Roman"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Windows("Список.xls").Activate
Range("C2").Select
ActiveCell.FormulaR1C1 = "Hyundai Accent"
Range("C4").Select
Windows("образец.xls").Activate
Range("L10:M10").Select
ActiveCell.FormulaR1C1 = "Т577ЕВ 161"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Times New Roman"
.FontStyle = "обычный"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Windows("Список.xls").Activate
Range("D2").Select
ActiveCell.FormulaR1C1 = "Т577ЕВ 161"
Range("D3").Select
End Sub
Подскажите пожалуйста, что нужно написать в макросе, чтобы можно было скопировать из всех файлов указанные значения ячеек в этот один файл ("Список.xls").
С уважением, Татьяна.
