Question

我想要实现的是一个动态宏，可以在许多不同的工作簿中使用以实现以下目的：我希望让用户输入他们想要复制的范围。此范围将被过滤。然后我想让用户选择范围来粘贴复制的数据。它们将粘贴的范围也被过滤（可能是与复制数据的位置不同的过滤器。理想情况下，用户只会选择要粘贴到范围的左上角单元格（而不是必须选择整个内容）。

下面的代码将按照我的意愿复制过滤后的数据（仅限可见单元格）。

Dim RangeCopy As Range
Dim RangeDest As Range

Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain     Range Object", Type:=8)
    MsgBox "The range you selected to copy is " & RangeCopy.Address
        RangeCopy.Select

Selection.SpecialCells(xlCellTypeVisible).Select 'selects visible cells only from previously selected range
    Selection.Copy

粘贴当然是棘手的部分。我发现我可以通过以下方式手动“粘贴”：

假设复制的范围是A1：A10，粘贴范围是B10：B20

我可以将公式“= A1”输入到单元格B10 ---＆gt;复制单元格B10 ----＆gt;选择要粘贴到的所需范围----＆gt;使用“Alt;”快捷方式----＆gt;糊。

以下代码尝试在VBA中自动执行此逻辑：

Dim RangeCopy As Range
Dim RangeDest As Range

Set RangeCopy = Application.InputBox("Select top cell of range to copy ", "Obtain Range Object", Type:=8)
    MsgBox "The top cell of the range you would like to copy is " & RangeCopy.Address


Set RangeDest = Application.InputBox("Select the top of the range to paste onto ", "Obtain Range Object", Type:=8)
    MsgBox "The top of the range you have selected to paste onto is " & RangeDest.Address

RangeDest.Formula = "=RangeCopy"
RangeDest.Copy

Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
    ActiveSheet.Paste

Application.CutCopyMode = False
Calculate

这提出了两个问题：

它只能正确粘贴到可见单元格上，但它当前正在输入“= CopyRange”作为文本到我要粘贴到的范围内（而不是公式设置“粘贴单元格”等于“复制单元格”
此代码尚不允许用户选择和确切范围。它允许他们选择一个起始点，然后将其复制并粘贴到粘贴到的列的末尾。我需要用户能够选择一个范围，并且还没有找到一种方法来做到这一点而不会发生错误。

在线搜索我发现了其他版本的“粘贴到可见细胞宏”。我试着将它们与我在这篇文章中分享的第一段代码结合起来。这种组合如下所示。

Sub Copy_Paste_Visible_Cells()

Dim RangeCopy As Range
Dim RangeDest As Range

Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain     Range Object", Type:=8)
    MsgBox "The range you selected to copy is " & RangeCopy.Address
        RangeCopy.Select

Set RangeDest = Application.InputBox("Select range to paste onto ", "Obtain Range Object", Type:=8)
    MsgBox "The range you have slected to paste onto is " & RangeDest.Address

Selection.SpecialCells(xlCellTypeVisible).Select 'selects visible cells only from previously selected range
Selection.Copy

Dim rng1 As Range
Dim rng2 As Range

    For Each rng2 In RangeDest
        If rng2.EntireRow.RowHeight > 0 Then
            rng2.PasteSpecial
            Set RangeDest = rng2.Offset(1).Resize(RangeDest.Rows.Count)
            Exit For
        End If
    Next

Application.CutCopyMode = False

End Sub

这样运行没有错误，但宏仅粘贴，直到它遇到隐藏的行。因此，如果行1,2 3和6可见但隐藏了4和5，则宏将粘贴到1,2和3而不是4,5或6。

我做了其他几次尝试，但这些似乎是迄今为止最有希望的。任何建议/帮助任何人都可以提供非常感谢。最大的关键是让用户完全动态，尽可能直观。

提前谢谢！

Answer 1

我认为以下代码可以执行您想要的操作：

Sub Copy_Paste_Visible_Cells()
    'This subroutine only handles copying visible cells in a SINGLE COLUMN

    Dim RangeCopy As Range
    Dim RangeDest As Range
    Dim rng1 As Range
    Dim dstRow As Long

    Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain     Range Object", Type:=8)
        MsgBox "The range you selected to copy is " & RangeCopy.Address

    Set RangeDest = Application.InputBox("Select range to paste onto ", "Obtain Range Object", Type:=8)
        MsgBox "The range you have selected to paste onto is " & RangeDest.Address

    If RangeCopy.Cells.Count > 1 Then
        If RangeDest.Cells.Count > 1 Then
            If RangeCopy.SpecialCells(xlCellTypeVisible).Count <> RangeDest.SpecialCells(xlCellTypeVisible).Count Then
                MsgBox "Data could not be copied"
                Exit Sub
            End If
        End If
    End If

    If RangeCopy.Cells.Count = 1 Then
        'Copying a single cell to one or more destination cells
        For Each rng1 In RangeDest
            If rng1.EntireRow.RowHeight > 0 Then
                RangeCopy.Copy rng1
            End If
        Next
    Else
        'Copying a range of cells to a destination range
        dstRow = 1
        For Each rng1 In RangeCopy.SpecialCells(xlCellTypeVisible)
            Do While RangeDest(dstRow).EntireRow.RowHeight = 0
                dstRow = dstRow + 1
            Loop
            rng1.Copy RangeDest(dstRow)
            dstRow = dstRow + 1
        Next
    End If

    Application.CutCopyMode = False
End Sub

注意：

仅在使用单列数据时才能使用。即，不要尝试使用跨越多列的源或目标范围。
单个源单元格可以复制到单个目标单元格（有点无聊，但可以使用），或者复制到一系列目标单元格。
可以将一系列源单元格复制到单个目标单元格（在这种情况下，它将继续填充所选单元格下方可见的任何行），或者提供给那里的一系列目标单元格源中的可见单元格数与目标中的可见单元格数相同。

Answer 2

尝试更改此行

  RangeDest.Formula = "=RangeCopy"

到

  RangeDest.Formula = ""=RangeCopy""

仅复制可见单元格并仅粘贴到可见单元格动态宏

2 个答案: