Private Sub Worksheet_Change(ByVal Target As Range)
Dim Low As Long
Dim Hign As Long
Dim lastRow As Long
Dim Tæl As Long
Dim Rlast As Long
Ark2.Range("A6:G50000").ClearContents
lastRow = Ark2.Cells(Ark1.Rows.Count, "A").End(xlUp).Row
Rlast = lastRow + 1
Low = Ark1.Range("I8").Value
Hign = Ark1.Range("J8").Value
Do Until Low > Hign
Ark2.Cells(Rlast, 1).Value = Low
Ark2.Cells(Rlast, 1).Value = Low
Ark2.Cells(Rlast, 3).Value = Ark1.Range("B8").Value
Ark2.Cells(Rlast, 2).Value = Ark1.Range("A8").Value
Ark2.Cells(Rlast, 4).Value = Ark1.Range("G8").Value
Ark2.Cells(Rlast, 5).Value = Ark1.Range("K8").Value
Low = Low + 1
Rlast = Rlast + 1
Loop
''''''''' koden gentages med sidste linje
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
lastRow = Ark2.Cells(Ark1.Rows.Count, "A").End(xlUp).Row
Rlast = lastRow + 1
Low = Ark1.Range("I9").Value
Hign = Ark1.Range("J9").Value
Do Until Low > Hign
Ark2.Cells(Rlast, 1).Value = Low
Ark2.Cells(Rlast, 1).Value = Low
Ark2.Cells(Rlast, 3).Value = Ark1.Range("B9").Value
Ark2.Cells(Rlast, 2).Value = Ark1.Range("A9").Value
Ark2.Cells(Rlast, 4).Value = Ark1.Range("G9").Value
Ark2.Cells(Rlast, 5).Value = Ark1.Range("K9").Value
Low = Low + 1
Rlast = Rlast + 1
Loop
End Sub
jeg har lavet den første del af koden, hvis du copy/past og retter koden kan du selv tiltøje resten.