Automatisere indsætning af rækker indeholdende rullelister, formler og referencer via knap

Det lyder muligt. Kunne du sende en kopi af filen / bygge en lille model, der illustrerer det ønskede.

@-adresse under min profil.

og så velkommen til...

Nej, upload, så andre også kan se opgaven !

Const totalTekst = "Total"

Dim antalRækker As Long
Dim totalStartRække As Long
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If Range("B" & ActiveCell.Row) = "" Then
        indsætProdukt "P1", ActiveCell.Row
    Else
        Message_1
    End If
End Sub
Private Sub CommandButton2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If Range("B" & ActiveCell.Row) = "" Then
        indsætProdukt "P2", ActiveCell.Row
    Else
        Message_1
    End If
End Sub
Private Sub CommandButton3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If Range("B" & ActiveCell.Row) = "" Then
        indsætProdukt "P3", ActiveCell.Row
    Else
        Message_1
    End If
End Sub
Private Sub CommandButton1_Click()
    hentProduktKalk "P1"
End Sub
Private Sub CommandButton2_Click()
    hentProduktKalk "P2"
End Sub
Private Sub CommandButton3_Click()
    hentProduktKalk "P3"
End Sub
Private Sub hentProduktKalk(produkt)
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
    totalStartRække = findTotalRække(totalUdstyrTekst)
    ledigRække = findLedigRække(totalStartRække)
   
    indsætProdukt produkt, ledigRække
End Sub
Private Function findLedigRække(sidsteRække)
    For ræk = sidsteRække To 1 Step -1
        If Range("B" & ræk) = "" Then
            findLedigRække = ræk
            Exit Function
        End If
    Next ræk
End Function
Private Function findTotalRække(tekst)
    With ActiveSheet.Range("B4:B" & antalRækker)
        Set c = .Find(tekst, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findTotalRække = c.Row
        Else
            findTotalRække = 0
        End If
    End With
End Function
Private Sub indsætProdukt(produktType, række)
Dim antalRæk As Long, antalKol As Long
    ActiveWorkbook.Sheets(produktType).Select
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    antalKol = ActiveCell.SpecialCells(xlLastCell).Column
   
    ActiveSheet.Range("A1:L" & antalRæk).Select
    Selection.Copy
   
    Sheets("kalkulation").Select
    ActiveSheet.Range("A" & række).Select
    Selection.Insert Shift:=xlDown
   
    Application.CutCopyMode = False
End Sub
Private Sub Message_1()
        MsgBox ("Marker en celle i tom række")
End Sub

Det virker som ønsket.

Tak og god jul..

Tak, og i lige måde, jeg beklager den lange ventetid, er der tildelt point?
Erkendtligheden ikke glemt.

Ok - der er også en verden udenfor E.

Nej ingen points endnu - du skal accepter mit svar i #3 - så sker det.