Vba loopt erg traag

[perry99]

Hallo,

Onderstaande vba duurt erg lang voordat de opdrachten verwerkt zijn.
Van alles geprobeerd, maar krijg het niet voor elkaar.

Ik hoop dat één van jullie de vba snel kan krijgen, ik krijg het niet voor elkaar.

Alvast bedankt voor het meedenken.

Groetjes,

Perry

Sub test()

 Application.ScreenUpdating = False

 For i = 1 To Columns(5).CurrentRegion.Rows.Count

 Range("J" & i).Select
 ActiveCell.FormulaR1C1 = "=IF(RC[-7]>10000000,RC[-7]-10000000,RC[-7])"
 Columns("J:J").Select
 Selection.NumberFormat = "0000000"
 Range("J" & i).Select
 Selection.Copy

 Range("K" & i).Select
 ActiveCell.FormulaR1C1 = "=IF(RC[-6]=""TK"","""",RC[-7])"
 Range("K" & i).Select
 Selection.Copy

 Range("L" & i).Select
 ActiveCell.FormulaR1C1 = "=IF(RC[-7]=""TK"",RC[-4],RC[-6])"
 Range("L" & i).Select
 Selection.Copy

 Range("M" & i).Select
 ActiveCell.FormulaR1C1 = "=RC[-6]"
 Range("M" & i).Select
 Selection.Copy

 Range("N" & i).Select
 ActiveCell.FormulaR1C1 = "=RC[-5]"
 Range("N" & i).Select
 Selection.Copy
 
 Columns("J:N").EntireColumn.AutoFit
 
 Application.CutCopyMode = False
 
 Next

With Application
    .ScreenUpdating = True
End With

End Sub

 

[cow18]

Sub Formules()
  Dim bereik   As Range
  With Sheets("blad1")                                     'dit is het blad waarmee je wenst te werken
    Set bereik = .Range("E1:E" & .Range("E" & Rows.Count).End(xlUp).Row)  'de E-kolom bepaalt het bereik

    With bereik.Offset(, Columns("J").Column - Columns("E").Column)  'voor de J-kolom
      .FormulaR1C1 = "=IF(RC[-7]>10000000,RC[-7]-10000000,RC[-7])"
      .NumberFormat = "0000000"
    End With

    With bereik.Offset(, Columns("K").Column - Columns("E").Column)  'voor de K-kolom
      .FormulaR1C1 = "=IF(RC[-6]=""TK"","""",RC[-7])"
    End With

    '....
  End With
End Sub

 

[perry99]

Hallo cow18,

Het werkt super.

Ben blij dat er mensen zoals jij zijn die anderen op dit forum met hun problemen willen
helpen.

RESPEKT

Nogmaals bedankt voor het meedenken.

Perry