Set to fit the row height

Sub AdjustRowHeight0 () Dim modelsheet As Worksheet, Printsheet as Worksheet Dim modelrng As Range ' template cell Dim mode Lrowheight () as double ' template row High data Dim modelrowcount As Long ' template line number Dim summodelheight As Double ' template cumulative row High Dim Adjustsca Le as Double ' scaling Const model_count = 5 ' How many documents are placed on each page Rowsinonepage/modelrowcount Dim desrng as Range ' paste position D Im breakrange as Range ' horizontal page Break location Dim pageheight As Double ' cumulative home row high Dim I as Long ' line number Set Modelsheet = thisworkb Ook. Worksheets ("document template") Set Printsheet = thisworkbook.worksheets ("Bulk print") with Modelsheet If Application.worksh Eetfunction.counta (. Cells) > 0 Then ' Count prevents the calculation of line number error Endrow =. Cells.find ("*",. Cells (1, 1), Xlvalues, Xlwhole, Xlbyrows, xlprevious). Row + 1 Endcol =. Cells.find ("*",. Cells (1, 1), Xlvalues, Xlwhole, Xlbycolumns, xlprevious). Column ' Get document template cell range Set modelrng =. Range (. Cells (1, 1),. Cells (Endrow, endcol)) ' Get the number of template cell rows and cumulative rowsHigh Modelrowcount = ModelRng.Rows.Count ReDim modelrowheight (1 to Modelrowcount) summodelhe ight = 0 For i = 1 to Modelrowcount modelrowheight (i) = Modelrng.rows (i). RowHeight summodelheight = summodelheight + modelrng.rows (i). RowHeight Next I end If end with with Printsheet. Cells.clear ' bulk copy of document template for i = 1 to ' If Application.WorksheetFunction.CountA (. Cells) = 0 Then Set desrng =. Range ("A1") Else Endrow =. Cells.find ("*",. Cells (1, 1), Xlvalues, Xlwhole, Xlbyrows, xlprevious). Row + 2 Set desrng =. Cells (Endrow, 1) End If modelrng.copy desrng ' actual operation also need to fill in the data next I ' only content beyond one page, E Xcel will automatically add a page break if. Hpagebreaks.count > 0 Then ' gets the cell where the first vertical page break is Set Breakrange =. HPageBreaks (1).         Location ' Cumulative first page height of all rows i = 1   Do While I < breakrange.row PageHeight = PageHeight +. Rows (i). RowHeight i = i + 1 Loop ' Get the blank line line number at the end of the last transcript rowsinonepage = Br Eakrange.row Do While Application.WorksheetFunction.CountA (.            Rows (rowsinonepage)) > 0 rowsinonepage = RowsInOnePage-1 Loop ' Calculate scaling Adjustscale = pageheight/(summodelheight * model_count) ' line-wise adjustment endrow =. Cells.find ("*",. Cells (1, 1), Xlvalues, Xlwhole, Xlbyrows, xlprevious). Row + 1 R = 0 for i = 1 to Endrow r = R + 1. Rows (i).                    RowHeight = Modelrowheight (r) * Adjustscale If r = Modelrowcount Then r = 0 ' per document adjustment Next I End If End With Set modelsheet = Nothing:set Printsheet = NothingEnd Sub

　　

Set to fit the row height