Dynamic increase of rows according to the size as well format of the text

Hi,

I am making an automated excel, using excel 2003 and vba coding of excel, in which a text is copied from one cell of a sheet to the other cells of the other sheet. I have the requirement to increase the rows according to the text so that I can show all the text information without expanding the row height or width (I am taking constant width = 172 and heigth = 60). The text is of Font "Calibri" of size "40". To see it properly zoom to 23%. I am using the following code:-

Sub Macro3()

    Dim strTemp As String
    Dim RowIncr As Integer
    Dim intRow As Integer
    Dim intCurrRow As Integer
    Dim intPrevRow As Integer
    Dim intProjDescLen As Integer
    Dim strTempPara As String
    Dim intlfFlag As Integer
        
    intlfFlag = -1
    intRow = 15
    intPrevRow = 0
    CurPos = 0
     
    strText = Worksheets("Sheet1").Cells(1, 1).Value
    
     intProjDescLen = Len(strText)

    strFind = vbLf
    
    Dim x As Variant
    Dim y As Variant
    Dim i As Long
    Dim j As Long
    
    x = Split(strText, vbLf)
 
    
    For i = 0 To UBound(x)

            strTemp = x(i)
      
            If (strTemp <> Empty And intlfFlag = 0) Then
                strTemp = vbLf & strTemp
            End If
            
            
            RowIncr = Len(strTemp) / 53 + 1
            
            intCurrRow = intRow + RowIncr + intPrevRow
            
            Worksheets("Sheet2").Range("D" & (intRow + 1) & ":D" & (intCurrRow)).MergeCells = True
            
            If (Len(strTemp) = 0) Then
                strTemp = vbLf
            End If
            
            Worksheets("Sheet2").Cells(intRow + 1, 4).Value = _
                Worksheets("Sheet2").Cells(intRow + 1, 4).Value & strTemp
        
            With Worksheets("Sheet2").Cells(intRow + 1, 4)
                .Font.Bold = False
                .Font.Underline = False
                .Font.Italic = True
                .Font.Size = 40
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
        
            intPrevRow = intPrevRow + RowIncr
            
                               
            If strTemp = vbLf Then
                intlfFlag = 1
            Else
                intlfFlag = 0
            End If
        Next i
    
End Sub

In this code I am Spliting the text on the basis of line feeds and then calculating the no. of rows requirement of each paragraph. After that the code merges all the rows required for a paragraph and then copy the paragraph to the merged rows. The same step repeated for the next paragraph till the end of the text. But, the problem is when the text is huge and contains many paragraph and each paragraph contains many character. In this case when the rows are merged and paragraph are copied then the last few paragraphs does not show the information completely even if they contains the whole contents of the paragraph if you don't expand the heigth and width of the rows. This issue comes only in case of large paragraph and having more number of line feeds. Is there any way we can copy the text to the merge cells and showing all the text in that cell or cells without expanding the row heigth and width. Also, Concatenate and LookUp is not required because I want text to be updatable after being copied to the merged rows.

Summary of requirement:-

Need to dynamic increase of rows according to the text.
Need constant row height = 60 and width = 172 and Font "Calibri" of Size "40" of the merged rows.
After text being copied row expansion horizontally and vertically shold not be required.
The merged cells should show all the text as it is copied without hiding any content. Also, cell data should be updatable.
Any logic is welcomed if above points are being considered.
Please help!!!!!!!