VBA Selecting all bold rows and inserting a copied row under it

What really do you want to get? You could upload small sample to show disired result.
Lets say row 2 ir "1234"
Column A looks like:
Text1
Text2
Text3
Text4

After you run your code result might be ... ?

Start would be this:

HI
Copy this
that
is
a
test
Whats
up
Hello


result should be like this:
Unbenannt.PNG

So each time there's a bold row it should copy the 2nd Row down there and shift the rest down.

You make it too complicate, I think.
If you need find rows with text in bold, so search just in one column (if all values in a row is in bold, so value in column A also should be in bold).
Insert your value from row 2 just after bold row is found.
Try this.

Sub Test()
Dim i As Long

For i = 2 To 2000
    If Range("A" & i).Font.Bold Then
        Rows(i + 1).Insert shift:=xlShiftUp
        Range("A" & i + 1).Clear
        Range("A" & i + 1).Value = Range("A2").Value
    End If
Next

End Sub

Hi kasan, thanks for your help. Excuse me, I did not get it right.
The macro can search just in column A, because i have nothing else bold there. BUT it should copy all Titles from A:K . Have a look at (a better) example: (The example one is only from A:C, I need it from A:K)
Unbenannt.PNG

If I modify the code to choose A:K it doesn't work anymore.

Hmm, and those Title1, Title2.. you insert with other macro, right?
Why don't you insert titles Name, Address, Country just after you manage Title1?

I didn't manage to do that. I used this code to create the titles:

Dim i As Long

For i = 1 To Sheets("Sheet1").Cells(Sheets("r").Rows.Count, "A").End(xlUp).Row
    If Sheets("Sheet1").Range("D" & i) <> Sheets("Sheet1").Range("D" & i + 1) Then
        Rows(i + 1).Insert shift:=xlShiftDown
        Sheets("Sheet1").Range("A" & i + 1).Value = Sheets("Sheet1").Range("D" & i + 2).Value

        With Sheets("Sheet1").Range("A" & i + 1)
            .Font.Size = 10
            .Font.Name = "Calibri"
            .Font.Bold = True
            .Font.Italic = False
            .HorizontalAlignment = xlCenter
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
        End With
        Range(Cells(i + 1, 1), Cells(i + 1, 11)).Merge
        i = i + 1
    End If
Next

What about this

Dim i As Long

For i = 1 To Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    If Sheets("Sheet1").Range("D" & i) <> Sheets("Sheet1").Range("D" & i + 1) Then
        Rows(i + 1).Insert shift:=xlShiftDown
        Sheets("Sheet1").Range("A" & i + 1).Value = Sheets("Sheet1").Range("D" & i + 2).Value

        With Sheets("Sheet1").Range("A" & i + 1)
            .Font.Size = 10
            .Font.Name = "Calibri"
            .Font.Bold = True
            .Font.Italic = False
            .HorizontalAlignment = xlCenter
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
        End With
        Range(Cells(i + 1, 1), Cells(i + 1, 11)).Merge
        
        'insert row for titles
        Rows(i + 2).Insert shift:=xlShiftDown
        Range("A" & i + 2).Value = "Name"
        Range("B" & i + 2).Value = "Address"
        'add all you want
                
        i = i + 2
    End If
Next

Probably

ActiveSheet.HPageBreaks.Add Before:=Rows(i+2)

Test it and if necessary play with that i+2 (may be i+1 will give you correct result)

Thx, never thought of writing this directly into the same code.. It works perfectly with

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(i + 1)

as you said