Excel Paste to visible, Transpose as Link combine function

Question

Hope you all are doing good. I am working on a workbook in which i have a column of 10 consecutive cells.

On another sheet there is a row where i want to paste that data as transposed but the problem is, some cells in that rows are not consecutive some of them are hidden. like in image:

Now i want to paste Data to visible cells only as Transpose and those cells must be paste as a link as if any changes made to first sheet, the relative cell in second sheet should also be change. Luckily i have done much working by my self as i found how to paste to visible cells only by following VBA code:

Sub PasteToVisible()
'Declarations
Dim Range1            As Range
Dim Range2            As Range
Dim InputRange      As Range
Dim OutputRange     As Range

'Prompt Box Title
xTitleId = "Paste to Visible"
'Start Input Range
Set InputRange = Application.Selection
'Select input range box
Set InputRange = Application.InputBox("Copy Range :", xTitleId, InputRange.Address, Type:=8)
'Select output range box
Set OutputRange = Application.InputBox("Paste Range:", xTitleId, Type:=8)
'Loop to paste the range in visible cells
For Each Range1 In InputRange
    Range1.Copy
    For Each Range2 In OutputRange
        If Range2.EntireRow.RowHeight > 0 Then
            Range2.PasteSpecial
            Set OutputRange = Range2.Offset(1).Resize(OutputRange.Rows.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False

End Sub'

This can Paste values to visible cells but in columns only (Not Transpose). For Transpose and Link, I am using a simple excel formula of Transpose as in Image below:

This can link the values in Transposed form. I want to combine all three functions (Paste to visible, Transpose and As a link) in one Step. Please Help me on this. I will really appreciate any suggestion and Help. Thanks in advance.

Instead of `PasteSpecial` use `Formula` or `FormulaR1C1` property and set the link. — L42, Feb 14 '18 at 05:34

L42 · Accepted Answer · 2018-02-14T09:23:37.980

As stated in comment, here's example of what I posted in the comment.

Sub marine()

    'Key board shortcut Ctrl + Shift + C

    Dim cr As Range, dr As Range, c As Range
    Dim xTitleId As String
    Dim i As Integer

    xTitleId = "Paste to Visible"
    If TypeOf Selection Is Range Then Set cr = Selection

    On Error Resume Next
    Set dr = Application.InputBox("Destination Range: ", xTitleId, , , , , , 8)
    On Error GoTo 0

    If Not dr Is Nothing _
    And Not cr Is Nothing Then
        Set dr = dr.Resize(1, 1)
        i = 0
        For Each c In cr
            Do While dr.Offset(, i).EntireColumn.Hidden
                i = i + 1
            Loop
            dr.Offset(, i).Formula = "=" & c.Address(, , , True)
            i = i + 1
        Next
    End If

End Sub

I assigned it in Ctrl+Shift+C shortcut.
It will copy the current selection and then prompt you to enter destination cell.
Just select destination cell (single cell would do) and it will paste the link.
Not yet optimized but I hope this gives you an idea.

Yup.. That works. Thank you soo much L42. I really appreciate your help. — Muhammad Owais, Feb 14 '18 at 09:13

QHarr · Answer 2 · 2018-02-14T08:50:52.813

You cannot use the in-built Excel pastespecial, transpose and link cells.

Adapting an idea from here you can create a named range and then refer to that.

The named range is called myRange and you select the range "A2:A6", go to the name box, enter the text "myRange" and hit enter. You can then select myRange from the Name Box to verify entered correctly. Or Ctrl + F3 to open Name Manager.

Function is by @BrettDJ that returns column letter from number.

Note you can refactor this into a more general function that accepts an input range and destination cell and does everything else and then call this from a button push sub that prompts for a range selection.

 Option Explicit

Public Sub TransposeDataWithLink()

    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet2")
    Dim numColumns As Long
    numColumns = ws.Range("myRange").Rows.Count

    Dim startColumn As Long
    startColumn = 3 'this would be inputted in call
    Dim startRow As Long
    startRow = 2 ''this would be inputted in call

    Dim visibleColumns As Long
    Dim currCell As Range
    Dim myRangeStartCol As Long
    Dim myRangeStartRow As Long

    myRangeStartCol = ws.Range("myRange").Column
    myRangeStartRow = ws.Range("myRange").Row

    Dim columnLetter As String

    columnLetter = Col_Letter(myRangeStartCol)

    Do Until visibleColumns = numColumns

        Set currCell = ws.Cells(startRow, startColumn)

        If currCell.EntireColumn.Hidden = False Then

            visibleColumns = visibleColumns + 1

            Dim myRangeRef As String
            myRangeRef = "=" & columnLetter & CStr(myRangeStartRow + visibleColumns - 1)

            currCell.Formula = myRangeRef

        End If

        startColumn = startColumn + 1

    Loop

End Sub


Public Function Col_Letter(ByVal lngCol As Long) As String
    Dim vArr
    vArr = Split(ActiveSheet.Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Thank you so much QHarr. I tried your function but its giving error "Method Range of Object_'worksheet' failed. I think i am missing something. But thanks anyway, the solution posted by L42 works perfect as i needed. I also appreciate your help. — Muhammad Owais, Feb 14 '18 at 09:22
You would have needed to change Set ws = wb.Worksheets("Sheet2") to your sheet — QHarr, Feb 14 '18 at 09:37

score 0 · Answer 3 · answered Feb 14 '18 at 09:25

So, as by L42. i found the solution to my problem.

Sub marine()

'Key board shortcut Ctrl + Shift + C

Dim cr As Range, dr As Range, c As Range
Dim xTitleId As String
Dim i As Integer

xTitleId = "Paste to Visible"
If TypeOf Selection Is Range Then Set cr = Selection

On Error Resume Next
Set dr = Application.InputBox("Destination Range: ", xTitleId, , , , , , 8)
On Error GoTo 0

If Not dr Is Nothing Then
    Set dr = dr.Resize(1, 1)
    i = 0
    For Each c In cr
        Do While dr.Offset(, i).EntireColumn.Hidden
            i = i + 1
        Loop
        dr.Offset(, i).Formula = "=" & c.Address(, , , True)
        i = i + 1
    Next
End If                                                                    
End Sub

This works perfectly.

Excel Paste to visible, Transpose as Link combine function

3 Answers3