Knap til indsætning af x antal nye linjer i Excel ark

Gør denne kode som du forventer?


    Dim rn As Range
    Dim rnNew As Range
    Dim i As Integer
   
    Set rn = Sheet1.Range("D2")
    Set rn = rn.End(xlDown) ' find sidste indtastning i kolonne D
    Set rn = rn.Offset(0, -3) ' kolonne A, sidste række
    Set rnNew = rn.Offset(1, 0).EntireRow
    For i = 1 To 10
        rnNew.Insert
        ' sæt formel i kolonne E
        rn.Offset(i, 4).Formula = "=" & Replace(rn.Offset(i, 39).AddressLocal, "$", "")
        ' sæt formel i kolonne AN
        rn.Offset(i, 39).Formula = "=SUM(" & _
            Replace(rn.Offset(i, 5).AddressLocal, "$", "") & ":" & _
            Replace(rn.Offset(i, 38).AddressLocal, "$", "") & ")+" & _
            Replace(rn.Offset(i, 3).AddressLocal, "$", "")
        ' kopier format fra sidste række
        rn.EntireRow.Copy
        rn.Offset(i, 0).EntireRow.PasteSpecial xlPasteFormats
    Next

Fandt lige ud af en noget kønnere måde at få sat formlerne på :o)


    Dim rn As Range
    Dim rnNew As Range
    Dim i As Integer
   
    Set rn = Sheet1.Range("D2")
    Set rn = rn.End(xlDown) ' find sidste indtastning i kolonne D
    Set rn = rn.Offset(0, -3) ' kolonne A, sidste række
    Set rnNew = rn.Offset(1, 0).EntireRow
    For i = 1 To 10
        rnNew.Insert
        ' sæt formel i kolonne E
        rn.Offset(i, 4).FormulaR1C1Local = "=R[0]C[35]"
        ' sæt formel i kolonne AN
        rn.Offset(i, 39).Formula = "=SUM(R[0]C[-34]:R[0]C[-1])+R[0]C[-36]"
        ' kopier format fra sidste række
        rn.EntireRow.Copy
        rn.Offset(i, 0).EntireRow.PasteSpecial xlPasteFormats
    Next

Hej anlu

Tak for dit svar :) Som det ser ud nu kan jeg umiddelbart ikke få det til at fungere.

Jeg får en Run-time error '424':

Object required

Trykker jeg så "Debug" går den ind i koden og highlighter følgende:
Set rn = Sheet1.Range("D2")

Det skulle nok egentligt være nævnt at den første bogføringsrække altid vil være række 6.

Det jeg har gjort er at gå op i "Udvikler" hvorefter jeg har indsat en knap (formularkontrolelement).

Jeg har så højreklikket på knappen, tildelt makroen under "Module3" hvilket var det modul den selv åbnede i, koden er indsat som følger:

Sub nylinje()
  Dim rn As Range
    Dim rnNew As Range
    Dim i As Integer
   
    Set rn = Sheet1.Range("D6")
    Set rn = rn.End(xlDown) ' find sidste indtastning i kolonne D
    Set rn = rn.Offset(0, -3) ' kolonne A, sidste række
    Set rnNew = rn.Offset(1, 0).EntireRow
    For i = 1 To 10
        rnNew.Insert
        ' sæt formel i kolonne E
        rn.Offset(i, 4).FormulaR1C1Local = "=R[0]C[35]"
        ' sæt formel i kolonne AN
        rn.Offset(i, 39).Formula = "=SUM(R[0]C[-34]:R[0]C[-1])+R[0]C[-36]"
        ' kopier format fra sidste række
        rn.EntireRow.Copy
        rn.Offset(i, 0).EntireRow.PasteSpecial xlPasteFormats
    Next
End Sub

Oh :) Det eneste der skulle ændres var: Set rn = Range("D6")

Smid endelig et svar, 1000 tak for hjælpen ;)

Det var så lidt :o)

Lige et enkelt spørgsmål til en rettelse:

Som sagt, så starter bogføringsrækkerne ved række 6.

Såfremt der KUN er bogført på række 6 og man kører makroen, så indsætter den de 10 linjer under min sum-række som først kommer adskillige rækker længere nede.

Vælger jeg derimod række 5 som udgangspunkt, og bogfører flere linjer, lad os sige 6, 7 og 8, så bliver de nye linjer indsat mellm række 6 og 7, til trods for at der er indhold i de efterfølgende linjer.

Er der en simpel måde hvorpå det kan løses? :)

For at fange den med om der kun er bogført på linje 6 (når vi starter i linje 6), kan man lave et check på om der står noget i D7 således:


    Set rn = Sheet1.Range("D6")
    If rn.Offset(1, 0).Value <> "" Then
        Set rn = rn.End(xlDown) ' find sidste indtastning i kolonne D
    End If
    Set rn = rn.Offset(0, -3) ' kolonne A, sidste række