Hvordan stopper jeg denne kode

Hej E.

Jeg har skrevet nedenstående kode.
Mit problem er bare at den bliver ved i alt uendelighed. Næsten da :-)

Har i en god ide til hvordan man kan få den til at stoppe når Selection.End(xlDown).Select ikke kan lade sig gøre mere ?

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 03-10-2002 by jkmi
'

'
Columns("J:J").Select
For Each cell In Range("omraade")
   
    Selection.End(xlDown).Select
    ActiveCell.Offset(columnOffset:=-1).Activate
    ActiveCell.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(columnOffset:=1).Activate
   
    Sheets("rekv. scales 01-09").Select
    ActiveCell.Offset(columnOffset:=5).Activate
    ActiveCell.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(columnOffset:=1).Activate
   
    Sheets("rekv. scales 01-09").Select
    ActiveCell.Offset(rowOffset:=-2, columnOffset:=1).Activate
    ActiveCell.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(rowOffset:=1, columnOffset:=-2).Activate
   
    Sheets("rekv. scales 01-09").Select
    ActiveCell.Offset(rowOffset:=2, columnOffset:=-5).Activate
   
    Selection.End(xlDown).Select
Next
   
End Sub