Hi,
try 
Option Explicit

Sub test()
    Dim xlRng As Range
    Dim aBorders: aBorders = Array(xlMedium, xlMedium, xlMedium, xlMedium, xlThin, xlThin)
    Dim sAddr As String
    Dim i As Byte
    Dim lngMaxRows As Long
    
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    
    With Worksheets("Start")
        lngMaxRows = .Cells(1, 1).CurrentRegion.Columns.Count
        
        Set xlRng = .Columns(1).Find(What:="*", After:=.Cells(.Rows.Count, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not xlRng Is Nothing Then
            sAddr = xlRng.Address
            Do
                With xlRng.CurrentRegion
                    .Select
                    Set xlRng = .Resize(, lngMaxRows - .Columns.Count + .Columns.Count)
                End With
                With xlRng
                    .Select
                    .WrapText = True
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    For i = 7 To 12
                        With .Borders(i)
                            .LineStyle = xlContinuous
                            .ColorIndex = xlAutomatic
                            .TintAndShade = 0
                            .Weight = aBorders(i - 7)
                        End With
                    Next i
                End With
                Set xlRng = .Columns(1).Find(What:=vbNullString, After:=xlRng.Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
                xlRng.RowHeight = 10
                Set xlRng = .Columns(1).Find(What:="*", After:=xlRng.Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
            Loop While Not xlRng Is Nothing And xlRng.Address <> sAddr And xlRng.Row <> 1
        End If
    End With
    
Proc_Exit:
    Application.ScreenUpdating = True
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description, vbCritical + vbOKOnly, "Error"
    Resume Proc_Exit
End Sub
What I did:
Instead of using the "currentregion" of a cell I check the max number of columns in row 1 first to determine how many columns should be "bordered"