Update VBA code - remove blank rows in newly created sheets

Hi friends,

I would like to kindly ask you for help with updating of VBA code in attached example spreadsheet.

Let me simple clarify what this file is doing and what I need to update.

1. In sheet Analysis are data with workers (column "B") & account groups(column "C")
2. Once you click on button CREATE LOI you will be able to choose one or more workers for which you want to create new sheet(s)
3. New sheets are created from default tab LOI 4.0 and fill in by appropriate data from Analysis for each worker/account group's combination
4. In final you can see new sheet(s) called per account group (e.q. CN-XX-XXXX-250X0X-PX0XX)
5. In new sheets was data pasted in range between rows 17-155.
6. At the end you will see the huge number of blank rows in created sheets.


My request:
Could you pls help me to update VBA code in attached example file, which ensure, that blank lines up to row 155 in every newly created sheet will be automatically deleted?

I suppose below code used in attached file should be updated, but I'm not sure:

Sub Create_LOI_Sheets()
Dim ag As String
Dim r, i, nr, Lastrow As Integer
Dim exists As Boolean


Lastrow = Sheets("Analysis").Range("C" & Rows.count).End(3).Row


Application.DisplayAlerts = False
Application.ScreenUpdating = False
For r = 8 To Lastrow
    exists = False


    ag = Sheets("Analysis").Cells(r, "C").Value


  If NameSelected(Sheets("Analysis").Range("B" & r)) = True Then
    For i = 1 To Worksheets.count
        If Worksheets(i).name = ag Then
            exists = True
        End If
    Next i


    If Not exists Then
        Sheets("LOI 4.0").Copy After:=Sheets(Sheets.count)
        With ActiveSheet
            .name = ag
            .Range("H9").Value = ag
        End With
    End If


    nr = Sheets(ag).Range("M" & Rows.count).End(3)(2).Row
    
    
  
        Sheets("Analysis").Range("U" & r).Copy Sheets(ag).Range("C" & nr)    'copy/paste Voucher month
        Sheets("Analysis").Range("V" & r).Copy Sheets(ag).Range("D" & nr)    'copy/paste Voucher year
        Sheets("Analysis").Range("W" & r).Copy Sheets(ag).Range("E" & nr)    'copy/paste Expected month
        Sheets("Analysis").Range("X" & r).Copy Sheets(ag).Range("F" & nr)    'copy/paste Expected year
        Sheets("Analysis").Range("S" & r).Copy Sheets(ag).Range("G" & nr)    'copy/paste Local Amount
        Sheets("Analysis").Range("AD" & r).Copy Sheets(ag).Range("H" & nr)   'copy/paste Parked By / Doc Type
        Sheets("Analysis").Range("T" & r).Copy Sheets(ag).Range("J" & nr)    'copy/paste Items
        Sheets("Analysis").Range("AF" & r).Copy Sheets(ag).Range("K" & nr)   'copy/paste Default Docu type
        Sheets("Analysis").Range("AE" & r).Copy Sheets(ag).Range("L" & nr)   'copy/paste CC & Account & Tr. Partner
        Sheets("Analysis").Range("H" & r).Copy Sheets(ag).Range("M" & nr)    'copy/paste Document#
        Sheets("Analysis").Range("I" & r).Copy Sheets(ag).Range("N" & nr)    'copy/paste Reference
        Sheets("Analysis").Range("J" & r).Copy Sheets(ag).Range("O" & nr)    'copy/paste Doc header text
        Sheets("Analysis").Range("Z" & r).Copy Sheets(ag).Range("P" & nr)    'copy/paste Description
        Sheets("Analysis").Range("AA" & r).Copy Sheets(ag).Range("Q" & nr)   'copy/paste Action Required /Person Responsible
    End If
Next r


Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thank you very much for your help