VBA - Stop af Loop funktion.

Hej!

Jeg har lavet en Loop funktion, hvor der på den ene eller anden måde går noget galt efter data er kopieret ind. Den skriver ikke en fejl til mig, men Excel går "kold" dvs. (Svare ikke) vises og Excel lukker. Jeg har prøvet at reducere mængden af data fra knap 3500 linjer til 33, med samme resultat.

Jeg har søgt blandt "loop" spørgsmål her inde og resoneret mig frem til virkemåde. Det kan bestemt være der fejlen ligger! 


Jeg har haft MSGbox (som også ses i programmet) som kom op ved kørsel af de forskellige IF funktioner, så jeg er overbevist om at disse fungere (dog skal man aldrig sige aldrig)

Nogle der har forstand på denne funktion?

Sub sortereData()
'
' sortereData
'

Do

Sheets("Import").Select
                           
If ActiveSheet.range("A12").Value = "INDEX,OPR" Then

    range("D1:D11").Select
    Selection.copy
    Sheets("data").Select
    range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    range("A1").Select
    Selection.End(xlDown).Select
    Sheets("Import").Select
    range("A1:D11").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    range("A1").Select
    Sheets("Import").Select

Else
End If

If ActiveSheet.range("A12").Value = "STOP TOOL" Then
' fejl ved dobbelt værktøjsskifts registering

    range("A9:D11").Select
    Selection.Delete Shift:=xlUp
    range("A1").Select

' MsgBox ("Der er dobbelt vkt skift på NMP:" & ActiveSheet.range("D3").Value & " & Tool" & ActiveSheet.range("D6").Value)
   
' copy cyklus

    Sheets("Import").Select
    range("D1:D11").Select
    Selection.copy
    Sheets("data").Select
    range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    range("A1").Select
    Selection.End(xlDown).Select
    Sheets("Import").Select
    range("A1:D11").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    range("A1").Select
    Sheets("Import").Select
Else
End If

If ActiveSheet.range("A12").Value = "MASKIN" Then
' fejl ved manglende værktøjsskifts registering

' Indsæt andet kendt data
' MsgBox ("data mangler ved VKT slut tool ved NMP:" & ActiveSheet.range("D3").Value & "& Tool" & ActiveSheet.range("D6").Value)

    Rows("9:9").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    range("A9").Select
    ActiveCell.FormulaR1C1 = "STOP TOOL"
    range("B9").Select
    ActiveCell.FormulaR1C1 = "NR"
    range("C9").Select
    ActiveCell.FormulaR1C1 = ":"
    range("D9").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C"
    range("A10").Select
    ActiveCell.FormulaR1C1 = "DATO"
    range("C10").Select
    ActiveCell.FormulaR1C1 = ":"
    range("D10").Select
    ActiveCell.FormulaR1C1 = "=R[8]C"
    range("A11").Select
    ActiveCell.FormulaR1C1 = "KLOKKEN"
    range("C11").Select
    ActiveCell.FormulaR1C1 = ":"
    range("D11").Select
    ActiveCell.FormulaR1C1 = "=R[8]C"
    range("A12").Select

' copy cyklus

    Sheets("Import").Select
    range("D1:D11").Select
    Selection.copy
    Sheets("data").Select
    range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    range("A1").Select
    Selection.End(xlDown).Select
    Sheets("Import").Select
    range("A1:D11").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    range("A1").Select
    Sheets("Import").Select


Else
End If
Loop Until ActiveSheet.range("D1").Value = 0

End Sub


Celle D1 har værdien [tal.tal]