Excel 仅粘贴到可见列

Excel Paste to Visible Columns only

希望你们一切都好。我在我的 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

任何帮助将不胜感激。

尝试

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