Hallo Leute, dieser Code kopiert zweimal die gesamte Zelle aus der letzten Zeile für jede Kategorie (A, B, C, D ...). Wie fügt man nun benutzerdefinierten Text für Spalte E und P (grüne Spalte) ein? Die 1. Kopie und die 2. Kopie haben also unterschiedliche Werte und es wäre schön, wenn ich diese Werte mithilfe der Eingabebox bestimmen könnte. Es wird also gefragt:

• Wie viele Reihen
• Text 1 für E
• Text 2 für E
• Text 1 für P
• Text 2 für P

jede mögliche Hilfe würde sehr geschätzt

Sub Zeile_einfügen()
      Dim sh As Worksheet, lastRow As Long, rngOO As Range, Fnd1 As Range
   Dim i As Long, Count As Long, arr, dict As Object
   
   Count = Application.InputBox(Prompt:="How many row?", Default:=2)
   Txt1E= Application.InputBox(Prompt:="1st Item Number?")
   Txt2E= Application.InputBox(Prompt:="2nd Item Number?")
   Txt1P= Application.InputBox(Prompt:="1st Kommentar_2?")
   Txt2P= Application.InputBox(Prompt:="2nd Kommentar_2?")
   
   Set sh = ActiveSheet
   lastRow = sh.Range("O" & sh.Rows.Count).End(xlUp).Row
   Set rngOO = sh.Range("O3:O" & lastRow)
   arr = rngOO.Value 'place the row in an array for faster iteration
   
   Set dict = CreateObject("Scripting.Dictionary")
   'Extract the unique categories:
   For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then dict(arr(i, 1)) = Empty
   Next i
   
   'finding the last unique categories and do copy its row of Count times:
   For i = 0 To dict.Count - 1
        Set Fnd1 = rngOO.Find(dict.Keys()(i), , , xlWhole, xlByRows, xlPrevious, False, , False)
        Fnd1.EntireRow.Copy
        sh.Range(Fnd1.Offset(1, 0), Fnd1.Offset(Count, 0)).EntireRow.Insert Shift:=xlDown
        Next i
   MsgBox (Count & " Row/s are added")
End Sub