Search code examples
excelvbacopy-paste

Excel Paste to Visible Columns only

Hope your all are doing great. I'm facing a problem in my excel workbook as i don't find any solution to paste to visible columns only. I've searched almost all over the Internet and only found paste to visible Rows only. Following is the SS of and example worksheet Example Worksheet

All i want to do is to Copy the Yellow Range and past it to Blue Range (Containing Hidden Columns).

Following is the code I've found useful for pasting to Visible Rows

Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
For Each rng1 In InputRng
    rng1.Copy
    For Each rng2 In OutRng
        If rng2.EntireRow.RowHeight > 0 Then
            rng2.PasteSpecial
            Set OutRng = rng2.Offset(1).Resize(OutRng.Rows.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False
End Sub

I've Tried to modify it to work on Columns but it was working same as for Rows as following:

Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
For Each rng1 In InputRng
    rng1.Copy
    For Each rng2 In OutRng
        If rng2.EntireColumn.ColumnWidth > 0 Then
            rng2.PasteSpecial Transpose:=True
            Set OutRng = rng2.Offset(1).Resize(OutRng.Columns.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False
End Sub

Any Help will be greatly appreciated.

Solution

  • try

    Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
Dim n As Integer
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
    For Each rng2 In OutRng
        If rng2.EntireColumn.ColumnWidth > 0 Then
           If rng2.EntireColumn.Hidden Then
           Else
                n = n + 1
                rng2 = InputRng.Cells(1, n)
            End If
        End If
    Next

Application.CutCopyMode = False
End Sub