VBA kode sløv

Hej Drenge,
Denne kode er ekstrem sløv , jeg kan se problemet ligger den del af koden jeg har udraget her , har i et godt råd ?
-----------
For i = 1 To r
For j = 1 To k
  Cells(i, j) = data(i, j)
tt = tt + 1
Next j

Next i
_---------------------------

Dim name, sti As String
Dim data() As Variant
Dim i, r, k As Integer
Dim tt As Integer

tt = 0
name = ThisWorkbook.name
sti = ThisWorkbook.Path

Application.ScreenUpdating = False
      Workbooks.Open Filename:= _
      ThisWorkbook.Path & "\SP__15.xlsx"

Sheets("Diverse").Activate

ActiveCell.SpecialCells(xlLastCell).Select
r = ActiveCell.Row
k = ActiveCell.Column
ReDim data(r, k)

For i = 1 To r 'rækker

    For j = 1 To k ' kolonner
    data(i, j) = Cells(i, j)
   
   
    Next j

Next i
Windows(name).Activate
    Sheets("Diverse").Select
  Cells.Select
  Selection.ClearContents
 

For i = 1 To r
For j = 1 To k
  Cells(i, j) = data(i, j)
tt = tt + 1
Next j

Next i
Application.ScreenUpdating = True