VBA- Copy cells incl. Diagram and update diagram reference

Good Morning,

I would like to automate an Excel file for my work, because the work steps repeat very often and it can easily lead to errors with several users.

I would like to first copy the area A1: R55 and paste below.
Ideally with 1 line spacing. This should be constantly expanded as new projects are added.
All my formulas and conditional formatting will be applied.
The reference of the diagram is unfortunately not taken over, it refers to the previously copied table.
And this is exactly my problem, because it is very difficult in many projects to change the reference always.

The table should be constantly updated, that is, the cells are copied continuously lower as new projects are added.

Unfortunately, I do not really know the macros and can not go on like this.

Now my question:
With the help of a colleague, I have already created a reasonably working macro. With the macro it is possible to copy and paste the desired area.
What I have not been able to do is to label the horizontal axis (very important as it has a formula related to the particular project) and to update the legend caption.
What would be great, would be to group the lines from 1 to 36 automatically. (of course referring to the newly inserted project)

Ideally, the whole thing should be possible with a button at the end of the sheet, which moves with down instead of a keyboard shortcut.

It would be a huge help if someone could help me here!
The Excel file including macro is attached.

Kind regards
Julian

Originally Posted by Julian91

... With the help of a colleague, I have already created a reasonably working macro ...

... the "collective" proved itself

Originally Posted by Julian91

... What I have not been able to do is to label the horizontal axis ...

e.g.:

nmbrobj = .SeriesCollection.Count

For lngZaehler = 1 To nmbrobj
    '...
    'If lngZaehler = 1 => "$L$95:$L$97"
    .SeriesCollection(lngZaehler).Values = Range(strWertY).Offset(56, 0)
    
    'If lngZaehler = 1 => "$L$95:$L$97" => "$I$95:$I$97"
    If lngZaehler = 1 Then .SeriesCollection(1).XValues = _
                                            Range(Replace(Range(strWertY).Offset(56, 0).Address, "L", "I", 1, -1, 1))
    '...
Next

Originally Posted by Julian91

... to group the lines from 1 to 36 automatically. (of course referring to the newly inserted project)...

e.g.:

ActiveSheet.Rows(lngLetzte & ":" & lngLetzte + corfact).Rows.Group

, where corfact is e.g.: Const corfact As Byte = 36

Originally Posted by Julian91

... Ideally ... with a button at the end of the sheet, which moves with down instead of a keyboard shortcut ...

First, e.g., add a button in cell "I45":

Sub a_button_add_formant()
    'ActiveSheet.Buttons.Add(            Left,              Top, Width, Height).Name = "Button_Add"
    ActiveSheet.Buttons.Add(Range("I45").Left, Range("I45").Top, 250.5, 53.25).Name = "Button_Add"
    With ActiveSheet.Shapes("Button_Add")
        .OnAction = "DiaKopieren_1"
        .Placement = xlMove 'xlMoveAndSize, xlMove, xlFreeFloating
        .ControlFormat.PrintObject = False
        .Fill.ForeColor.RGB = RGB(200, 200, 200)
        .TextFrame.Characters.Text = "Add a new project"
        .TextFrame.Characters.Font.Size = 10
        .TextFrame.Characters.Font.ColorIndex = xlAutomatic
    End With
End Sub

Second, corresponding changes in the main code, e.g. (invented "on the flight"):

nmbrobj = .Shapes.Count
lngZaehler = nmbrobj

For indx = nmbrobj To 1 Step -1
    If .Shapes(indx).Name = "Button_Add" Then
        If indx < lngZaehler Then .Shapes(indx).Delete ': Exit Sub
        lngZaehler = lngZaehler - 1
    End If
Next

In conclusion, it could look like this (interesting ... was that what it was about ?):

Option Explicit

Sub DiaKopieren_1()
    Const corfact As Byte = 36
    
    Dim lngLetzte As Long, lngZaehler As Long, nmbrobj As Integer, indx As Integer
    Dim strWertY As String, strName As String
    
    With ActiveSheet
        lngLetzte = .Columns(9).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
        
        .Range(.Cells(lngLetzte - 56, 1), .Cells(lngLetzte - 2, 18)).Copy Destination:=.Cells(lngLetzte, 1)
        Application.CutCopyMode = False
        
        With .ChartObjects
            indx = .Count
            .Item(indx).Name = "Diagramm " & 9 + indx 'Your "Diagrams" start with "10" => "Diagramm 10"
        End With
        
        With .ChartObjects(indx).Chart
            nmbrobj = .SeriesCollection.Count
            For lngZaehler = 1 To nmbrobj
                strWertY = ActiveSheet.ChartObjects(indx - 1).Chart.SeriesCollection(lngZaehler).Formula
                If Mid(strWertY, 9, 1) <> "," Then strName = Mid(Split(strWertY, ",")(0), 9)
                strWertY = Split(strWertY, ",")(2)
                If strName <> "" And strName <> "=SERIES(" Then
                    .SeriesCollection(lngZaehler).Name = _
                                        "=" & ActiveSheet.Name & "!" & Range(strName).Offset(56, 0).Address
                End If
                'If lngZaehler = 1 => "$L$95:$L$97"
                .SeriesCollection(lngZaehler).Values = Range(strWertY).Offset(56, 0)
                'If lngZaehler = 1 => "$L$95:$L$97" => "$I$95:$I$97"
                If lngZaehler = 1 Then .SeriesCollection(1).XValues = _
                                        Range(Replace(Range(strWertY).Offset(56, 0).Address, "L", "I", 1, -1, 1))
                strName = ""
            Next
            .ChartTitle.Text = "=" & .Parent.Parent.Name & "!" & Cells(lngLetzte, 1).Address
        End With
        
        .Rows(lngLetzte & ":" & lngLetzte + corfact).Rows.Group
        
        nmbrobj = .Shapes.Count
        lngZaehler = nmbrobj
        For indx = nmbrobj To 1 Step -1
            If .Shapes(indx).Name = "Button_Add" Then
                If indx < lngZaehler Then .Shapes(indx).Delete ': Exit Sub '???
                lngZaehler = lngZaehler - 1
            End If
        Next
    End With
    
    ActiveWindow.ScrollRow = lngLetzte
End Sub