Copy values between workbooks - vba

Question

I've made a code that copy values between workbooks.
The problem is it is too slow (it takes almost 30 minutes to copy to 60 files).
I think it's because I set value for each cell.
For Each cl In rg
For c = 0 To 4
wb.ActiveSheet.Cells(i + c, 2 + n).Value = cl.Offset(r - 2, c).Value
Next
n = n + 1
Next
The reason I do it is the task: there are 60 rows of cells (there is a formula in each cell) (550 cells in each row). Values (results, not formulas) of first row must be copied to the first excel workbook (there are 60 files), second row to the second workbook, etc. This row is copied in the table 5x110 where data is filled by columns (first 5 cells of the row - is the first column, etc.).
How to optimize this? (I've tried copy - past values - becomes not responding).
I've already done opening Excel Application in invisible mode.
I haven't tried to write to the closed excel file (without opening it) yet (but I think it will not become working much faster)
Sub CopyM()
Dim rg As Range, r As Long, c As Long, wb As Excel.Workbook, col As Long, i As Long, j(1 To 60) As String, k As Long
Dim FileName As String
Dim app As New Excel.Application
Dim FolderPath As String, p As String, cl As Range, n As Long
app.Visible = False
i = 2
For k = 1 To 60
If k < 51 Then
j(k) = k
Else
j(k) = ("d" & (k - 50))
End If
Next k
Set rg = Range("K2")
Application.ScreenUpdating = False
For col = 16 To 560 Step 5
Set rg = Union(rg, Cells(2, col))
Next col
p = ActiveWorkbook.Path
FolderPath = (p & "\")
FileName = (FolderPath & j(1) & ".xlsm")
n = 0
For r = 2 To 61
FileName = (FolderPath & j(r - 1) & ".xlsm")
Set wb = app.Workbooks.Open(FileName)
n = 0
For Each cl In rg
For c = 0 To 4
wb.ActiveSheet.Cells(i + c, 2 + n).Value = cl.Offset(r - 2, c).Value
Next
n = n + 1
Next
wb.Close savechanges:=True
app.Quit
Application.ScreenUpdating = True
Cells(1, 1).Value = (r - 1) & "/60"
Application.ScreenUpdating = False
Next
Set app = Nothing
Application.ScreenUpdating = True
Cells(1, 1).Value = ""
MsgBox "Finished"
End Sub

Answer 1

That's awesome!!
The time of execution significantly reduced to 3 minutes 19 seconds!
Thank you #chrisneilsen for suggestion!
Here is the edited code:
Sub CopyM()
Dim r As Long, wb As Excel.Workbook, i As Long, p As String, n As Long
Dim FileName As String, j(1 To 60) As String, k As Long
Dim app As New Excel.Application
Dim FolderPath As String, ai As Variant, bi(1 To 5, 1 To 110) As Variant
app.Visible = False
For k = 1 To 60
If k < 51 Then
j(k) = k
Else
j(k) = ("d" & (k - 50))
End If
Next k
Application.ScreenUpdating = False
p = ActiveWorkbook.Path
FolderPath = (p & "\")
FileName = (FolderPath & j(1) & ".xlsm")
r = 2
i = 0
n = 1
For r = 2 To 61
ai = Range(Cells(r, 11), Cells(r, 560)).Value
i = 0
n = 1
For i = 1 To 550 Step 5
bi(1, n) = ai(1, i)
bi(2, n) = ai(1, 1 + i)
bi(3, n) = ai(1, 2 + i)
bi(4, n) = ai(1, 3 + i)
bi(5, n) = ai(1, 4 + i)
n = n + 1
Next
FileName = (FolderPath & j(r - 1) & ".xlsm")
Set wb = app.Workbooks.Open(FileName)
wb.ActiveSheet.Range("B2:DG6").Value = bi
wb.Close savechanges:=True
app.Quit
Application.ScreenUpdating = True
Cells(1, 1).Value = (r - 1) & "/60"
Application.ScreenUpdating = False
Next
Set app = Nothing
Application.ScreenUpdating = True
Cells(1, 1).Value = ""
MsgBox "Finished"
End Sub