CODEWITHSUNDEEP
excelvba
Pierre14
Pierre14

Reputation: 1

Excel VBA macro cell copy under each other

I want to have a macro which makes the followings:

  1. open all files on a Directory (more than 600 files)
  2. modify the I36 and I37 values
  3. Copy I48 into file 'AKL LASER SUM W27_36 macro1.xls' A3 cell
  4. Copy L36 into file 'AKL LASER SUM W27_36 macro1.xls' B3 cell
  5. ALL FILES I48 and L36 copy continously under each other to 'AKL LASER SUM W27_36 macro1.xls' file from A3 and B3 (so next file open, modify I36 and I37, after copy I48 and L36 to A4 and B4)

With this I can open and modify all files well, and copy the cells but only every time to A3 and B3, not under each other.

Thanks

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

Upvotes: 0

Views: 124

Answers (1)

YowE3K
YowE3K

Reputation: 23974

If you add a variable to keep track of which row you are currently writing to, it becomes quite easy:

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

I also changed the code slightly so that it doesn't use a Copy command - that sometimes causes issues if the user is doing anything else which uses the clipboard while the macro is running.

Upvotes: 1

Related Questions