vba Copy Paste Transpose Link

A modification if Tinman's Alternate Approach

Because .Rows.Count and .Columns.Count do not encapsulate the entirety of ranges which have more than one area (that is, where .Areas.Count >1) TransposeLink as defined above needs some modifcation to handle these cases.

Namely, we will have to define an helper function that gets the footprint of all of the areas of source, then iterate across the rows and columns of that footprint rather than of source directly. In doing so, we also must check if the footprint Intersects with source, and only iff that is the case, transfer over the formula.

Application of these changes renders code somewhere along the lines of the below.

Option Compare Binary
Option Explicit
Option Base 1


Public Sub TransposeLink(ByRef src As Range, ByRef dest As Range)
    Dim ASU As Boolean, _
        ADA As Boolean, _
        ACM As Excel.XlCalculation, _
        row As Long, _
        col As Long
    
    With Application
        Let ASU = .ScreenUpdating: Let .ScreenUpdating = False
        Let ADA = .DisplayAlerts:  Let .DisplayAlerts = False
        Let ACM = .Calculation:    Let .Calculation = Excel.XlCalculation.xlCalculationManual
    End With
    
    With footprint(src)
        ReDim res(1 To .Columns.Count, 1 To .Rows.Count)            '' dim in as variant()
        Let res = dest.Resize(.Columns.Count, .Rows.Count).Formula  '' to not overwrite data
        For row = 1 To .Rows.Count
            For col = 1 To .Columns.Count
                If Not Intersect(.Cells(row, col), src) Is Nothing Then _
                    Let res(col, row) = "=" & .Cells(row, col).Address(RowAbsolute:=True, ColumnAbsolute:=True, External:=True)
        Next col, row
        Let dest.Resize(.Columns.Count, .Rows.Count).Formula = res
    End With
    
    With Application
        Let .ScreenUpdating = ASU
        Let .DisplayAlerts = ADA
        Let .Calculation = ACM
    End With
End Sub


Public Function footprint(ByRef rng As Range) As Range

    Dim numAreas           As Long, _
        rMin As Long, rMax As Long, _
        cMin As Long, cMax As Long, _
        iter As Long
    
    Let numAreas = rng.Areas.Count
    If numAreas = 1 Then Set footprint = rng: Exit Function
    
    For iter = 1 To numAreas
        With rng.Areas(iter)
            If iter = 1 Then
                Let rMin = .Item(1).row
                Let cMin = .Item(1).Column
                Let rMax = .Item(.Count).row
                Let cMax = .Item(.Count).Column
            Else
                If .Item(1).row < rMin Then Let rMin = .Item(1).row
                If .Item(1).Column < cMin Then Let cMin = .Item(1).Column
                If .Item(.Count).row > rMax Then Let rMax = .Item(.Count).row
                If .Item(.Count).Column > cMax Then Let cMax = .Item(.Count).Column
            End If
        End With
    Next iter
    
    With rng.Worksheet
        Set footprint = .Range(.Cells(rMin, cMin), .Cells(rMax, cMax))
    End With
End Function

Note the addition of the Option Explicit module option at the top of this code segment - enabling this helps you to keep track of your what variables you are using by forcing you to dim them in before using them.

Testing

A simple test which illustrates the impact is

Sub trans_test()
    [A1:U9] = "=Right(Address(Row(),Column(),4))&Left(Address(Row(),Column(),4))"
                                            ' yellow - source
    TransposeLink [A1,C3,E5], [I3]          ' green  - new
    OLD_TransposeLink [A1,C3,E5], [Q5]      ' red    - old
    
    Cells.Style = "normal"
    [A1,C3,E5].offset(0, 0).Style = "neutral"
    [A1,C3,E5].offset([I3].row - 1, [I3].Column - 1).Style = "good"
    [A1,C3,E5].offset([Q5].row - 1, [Q5].Column - 1).Style = "bad"
    
End Sub

where OLD_TransposeLink is the original version of the subroutine and which generates the worksheet shown below. In this example, a background set of formulas is generated, and then A1, C3, and E5 (highlighted in yellow) are selected as the data source. The green highlighted region represents the pasting operation completed by the changed script and the red highlighted region represents that of the original script. Note that in the original output, 3C and 5E are not properly copied over from the source.

Note: top left cell is cell A1