Autofit row height for specific range , then resize entire row height for each row ,as height of each cell after autofit on the cited range?

Question

I need to Autofit row height only for specific range eg ("B3:B8") But not autofit the entire row .
Autofit row height for specific range, then resize entire row height for each row,depends on height of each cell after autofit on the cited range respectively. On the below code, I did not use EntireRow but the code forcibly autofit entire row.
In advance, thanks for your help.

Sub AutoFit_Range()
 
    Dim rng As Range
     Set rng = ThisWorkbook.Sheets(1).Range("B3:B8")
         rng.Rows.AutoFit
 
End Sub

Answer 1

AutoFit (Entire) Rows of a Range

• It will copy the range (including its column widths) to another worksheet, autofit the rows there and loop through the rows of the new range and use their heights to be set in the initial range.

Option Explicit

Sub AutoFit_Range()
    
    Const rgAddress As String = "B3:B8"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ash As Object: Set ash = ActiveSheet
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(1)
    Dim drg As Range: Set drg = dws.Range(rgAddress)
    Dim rCount As Long: rCount = drg.Rows.Count
    
    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Set sws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    drg.Copy
    
    Dim srg As Range
    With sws.Range("A1")
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteAll
        Set srg = .Resize(rCount)
    End With
    srg.EntireRow.AutoFit
    
    Dim r As Long
    For r = 1 To rCount
        drg.Rows(r).RowHeight = srg.Rows(r).RowHeight
    Next r
    
    Application.DisplayAlerts = False
    sws.Delete
    Application.DisplayAlerts = True

    ash.Activate
    
    Application.ScreenUpdating = True

End Sub

Answer 2

Here something.

Sub fitheightfromacell()

Range("B3:B8").Select
Selection.RowHeight = Range("B3").Height
Range("B3").Select
End Sub

if want put specific height to b3:b8

you can do that too

Sub heightresize()

Range("B3:B8").Select
Selection.RowHeight = 30
Range("B3").Select
End Sub

the 30 is the height you want manually. if you want to take height from another cell, just uses the first code,

or autofit just selected rows

Sub autofitslectionrows()

Range("B3:B8").Select
Selection.Rows.AutoFit
Range("B3").Select
End Sub