调整复制区域中的行高

Sub CopyCells()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range: Set srg = wb.Names("Ex_d_Visual").RefersToRange
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet1")
    Dim dCell As Range: Set dCell = dws.Range("A9")
    
    srg.Copy dCell
        
    Dim sCell As Range
        
    For Each sCell In srg.Cells
        dCell.RowHeight = sCell.RowHeight
        Set dCell = dCell.Offset(1)
    Next sCell
        
End Sub

在您的示例中，由于您知道目标合并区域中的行数相同，因此可以使用.Resize将其定义为与源区域大小相同。
然后，在行上循环以应用原始行高，如下所示：

Const RangeName = "Ex_d_Visual"
Const SheetName = "Sheet1"
Const RangeAddress = "A9"

Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Names(RangeName).RefersToRange

Dim DestinationRange As Range
Set DestinationRange = ThisWorkbook.Sheets(SheetName).Range(RangeAddress).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

Dim Row As Range, Offset As Long
For Each Row In SourceRange.Rows
    DestinationRange.Rows(1 + Offset).RowHeight = Row.Height
    Offset = Offset + 1
Next Row