Macro til indsætning af linier

Hej,
Denne makro skulle kunne klare dette.
Der er følgende forudsætninger:

I A kolonen må der ikke ved start forekomme blanke celler, koden vil da stoppe der.

I M cellen skal der stå heltal, altså 0, 1, 2 osv. der må ikke stå 1,5

Data området starter i cellen A2, jeg går ud fra at A1 indeholder overskrifter.

Sub mcrRowInd()
    'Variable
    Dim varAntal As Double
    Dim i As Double
   
    'Start celle ikke overskrift
    Range("A2").Select
   
    'Gennemløb af data
    Do Until ActiveCell.Value = ""
        If ActiveCell.Offset(0, 12) <> 0 Then
            varAntal = ActiveCell.Offset(0, 12).Value 'Antal Row's der skal ind
            ActiveCell.Offset(1, 0).Select
           
            For i = 1 To varAntal
                Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select 'Marker Row
                Selection.Insert Shift:=xlDown 'Indsæt Row
            Next
            ActiveCell.Offset(varAntal, 0).Select 'Gå x antal Row's ned
        Else
            ActiveCell.Offset(1, 0).Select 'Gå en Row ned
        End If
    Loop

End Sub

Hilsen
Tue Hellstern
www.F1-support.dk

perfekt

tak for hjælpen

Ligger du et svar så jeg kan afslutte

Hej,
Super du kunne bruge det :-)

Hilsen
Tue Hellstern
www.F1-support.dk