Sub AutoFitMergedCells()
Dim TargetBook As Workbook
Dim TargetRows As Range
Set TargetRows = Selection.Rows
Set TargetBook = TargetRows.Worksheet.Parent
Dim NormalFontName As String
NormalFontName = TargetBook.Styles("Normal").Font.Name
Dim NormalFontSize As Double
NormalFontSize = TargetBook.Styles("Normal").Font.Size
Dim TestBook As Workbook
Set TestBook = Workbooks.Add
Dim TestSheet As Worksheet
Set TestSheet = TestBook.Worksheets(1)
Dim TestCell As Range
Set TestCell = TestSheet.Cells(1, 1)
TestBook.Styles("Normal").Font.Name = NormalFontName
TestBook.Styles("Normal").Font.ThemeFont = xlThemeFontNone
TestBook.Styles("Normal").Font.Size = NormalFontSize
Dim Row As Range
For Each Row In TargetRows
Dim MergedCells As Range
Set MergedCells = Row
Dim MergedWidth As Double
MergedWidth = 0
Dim Col
For Each Col In MergedCells.Areas(1).Columns
MergedWidth = MergedWidth + Col.ColumnWidth
Next
MergedWidth = MergedWidth
MergedCells.Copy
TestSheet.Paste TestCell
TestCell.MergeCells = False
TestCell.ColumnWidth = MergedWidth
TestCell.Value = MergedCells.Value
TestCell.EntireRow.AutoFit
MergedCells.RowHeight = TestCell.RowHeight
Next
End Sub