copying a defined named range with merged cells from one worksheet to a new worksheet at a selected-CodePudding

Inspection templates

Depending on which inspection is going to be undertaken I load the inspection sheet (a name defined selection) from Inspection template and add it to a worksheet that contains all the tag information for a selected tag to be inspected

Sub copycells()

' copycells Macro
'

'
    Application.Goto Reference:="Ex_d_Visual"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A9").Select    
    ActiveSheet.Paste

End Sub

the problem is that the merged cells height does not copy across to the new worksheet. "EX_d_Visual" = A1:K41

I have tried many different copy paste options and paste special options but can't seem to get it to work, I think that I may need to use a "for cell next" loop and get each original cell height then set the new sheet equivalent cell to the same height. getting the cell height from the original is doable using the range "Ex_d_Visual" but just not sure how to set the new sheet as I only know the single cell that I have copied into.

CodePudding user response：

Adjust Row Height in a Copied Range

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

CodePudding user response：

In your case, since you know that the destination merged range will have the same number of rows in it, you can define it using .Resize to be identical in size to the source range.

Then looping over the rows to apply the original row height could look like this:

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