Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Копирование значений ячеек
 
Доброго времени суток!  
 
Помогите пожалуйста с написанием макроса,который бы выполнял копирование значений определенных ячеек из множества файлов(имеют один вид) в один файл. Получается есть главная папка, в которой находятся подпапки, в этих подпапках находятся файлы. Из этих файлов необходимо скопировать в один файл(находится в корне главной папки -"Список.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").  
 
С уважением, Татьяна.
Страницы: 1
Наверх