时间戳

首页 > 解决方案 > Excel 仅粘贴到可见列

excel - Excel 仅粘贴到可见列

问题描述

希望你们都做得很好。我在我的 excel 工作簿中遇到了一个问题，因为我没有找到任何只能粘贴到可见列的解决方案。我几乎在互联网上搜索过，只发现粘贴到可见行。以下是 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

任何帮助将不胜感激。

标签： excelvbacopy-paste

解决方案

尝试

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

推荐阅读