Excel仅粘贴到可见列

Question

希望大家都做得很好。我在Excel工作簿中遇到一个问题，因为我找不到仅粘贴到可见列的任何解决方案。我几乎在整个Internet上进行搜索，仅发现粘贴到可见行中。以下是SS和示例工作表

我要做的就是复制黄色范围并将其粘贴到蓝色范围（包含隐藏列）。

以下是我发现对粘贴到可见行有用的代码

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

我试图对其进行修改以使其适用于列，但其与行的用法相同，如下所示：

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

任何帮助将不胜感激。

Answer 1

尝试

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