VBA overføre fra et art til et andet og gentage 2 øverste linjer

Hejsa,

Jeg har en udforing med hvordan jeg får gentaget 2 linjer i toppen af hver side på et ark hvor jeg overfører til.
Håber jeg kan forklare det ordentligt.

Nedenstående formel overfører til et andet faneblad.
Den skal overføre, så det passer med en A4 ark, hvilket den gør nu.
Men vil gerne have den til at indsætte de samme 2 linjer øverst på hver side, når den overfører. De linjer der skal gentages, ligger på det ark der overføreres til, er linjerne 99 og 100.

Håber der er et klogt hoved der kan hjælpe med denne.



Sub Oveførtiltilbud2()
   
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, n As Long, i As Long, b As Long, Lastrow As Long
   
   
    Set ws1 = Sheets("Kalk")
    Set ws2 = Sheets("Tilbud dansk")
    Set ws3 = Sheets("Tilbud Engelsk")
    Worksheets("Tilbud dansk").Unprotect
    ws2.Range("A105:A" & Rows.Count).ClearContents
    ws2.Range("B105:B" & Rows.Count).ClearContents
    ws2.Range("C105:C" & Rows.Count).ClearContents
    ws2.Range("D105:D" & Rows.Count).ClearContents
    ws2.Cells.Borders.LineStyle = xlLineStyleNone
   
    LR1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
    ActiveSheet.Unprotect
   
    Application.ScreenUpdating = False
   
    LR2 = 105
   
    For i = 10 To LR1
   
        If ws1.Range("B" & i).Value = ("TEKST") And ws1.Range("M" & i).Value = ("JA") Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 12
            ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 12
            ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "C").Value = ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 12
            ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "D").Value = ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 12
            ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
   
            LR2 = LR2 + 1
       
        End If

If ws1.Range("B" & i).Value = "JA" Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 12
            ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 12
            ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "C").Value = ws1.Cells(i, "R").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 12
            ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "D").Value = ws1.Cells(i, "Q").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 12
            ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
           
        LR2 = LR2 + 1

End If
       
    Next i
   
    Application.ScreenUpdating = True
       
    ' GENLÅSNING AF ARK
   
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("Tilbud dansk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("Kalk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("Tilbud Engelsk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
   
End Sub