Excel VBA копия макро ячейки друг под другом

Question

Я хочу, чтобы иметь макрос, который делает следующее:

1. открыть все файлы на каталог (более 600 файлов)
2. изменяющие I36 и I37 ценности
3. Copy I48 в файл 'AKL LASER SUM W27_36 macro1.xls' A3 ячейки
4. Copy L36 в файл 'AKL LASER SUM W27_36 macro1.xls' B3 клеток
5. ВСЕ ФАЙЛЫ I48 и L36 копию под непрерывно друг к другу " AKL LASER SUM W27_36 macro1.xls 'fil е с A3 и B3 (так следующий файл открыт, изменять I36 и I37, после копирования I48 и L36 до А4 и В4)

С этим я могу открыть и изменить все файлы хорошо, и копировать клетки, но только каждый время до A3 и B3, а не под друг друга.

Благодаря

Sub OpenAllWorkbooks() 

    Dim MyFiles As String 

    MyFiles = Dir("D:\GTMS\AKL Laser 4 W27_36\*.xls") 
    Do While MyFiles <> "" 

    Workbooks.Open "D:\GTMS\AKL Laser 4 W27_36\" & MyFiles 


    Range("I36").Value = 2.03 
    Range("I37").Value = 2.19 

    Range("I48").Copy _ 
    Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Range("A3") 

    Range("L36").Copy _ 
    Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Range("B3") 

    MsgBox ActiveWorkbook.Name 

    ActiveWorkbook.Close SaveChanges:=True 

    MyFiles = Dir 
    Loop 

End Sub 

Answer 1

Если добавить переменную для отслеживания какой строке вы сейчас пишете, она становится довольно легко:

Sub OpenAllWorkbooks() 

    Dim MyFiles As String 
    Dim destRow As Long 
    destRow = 3 

    MyFiles = Dir("D:\GTMS\AKL Laser 4 W27_36\*.xls") 
    Do While MyFiles <> "" 

     Workbooks.Open "D:\GTMS\AKL Laser 4 W27_36\" & MyFiles 

     With ActiveWorkbook.Worksheets(1) 
      .Range("I36").Value = 2.03 
      .Range("I37").Value = 2.19 

      Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Cells(destRow, "A").Value = .Range("I48").Value 

      Workbooks("AKL LASER SUM W27_36 macro1.xls").Worksheets("Munka1").Cells(destRow, "B").Value = .Range("L36").Value 

      destRow = destRow + 1 

     End With 

     MsgBox ActiveWorkbook.Name 

     ActiveWorkbook.Close SaveChanges:=True 

     MyFiles = Dir 
    Loop 

End Sub 

Я также немного изменил код так, чтобы он не использует команду Copy, что иногда вызывает проблемы, если пользователь делает что-либо еще, что использует буфер обмена во время работы макроса.