VBA 仅粘贴到可见单元格

Question

我在 Sheet2 F2:F41上有一系列单元格，我想将其粘贴到 Sheet1 中的可见单元格中。 Sheet1 上的可见单元格位于M111:M643范围内。 我的问题是，Excel 根据需要将其粘贴到另一个单元格。

摘录：

我错过了循环或类似的东西吗？

Sheets("Tabelle2").Select 
Dim tgt As Worksheet
Set tgt = ThisWorkbook.Sheets("Tabelle1") 
Dim from As Range 
Dim destination As Range 
Set from = Sheets("Tabelle2").Range("F2:F41") Selection.Copy   
Set destination = Sheets("Tabelle1").Range("M11:M643").SpecialCells(xlCellTypeVisible) from.Copy Destination:=Sheets("Tabelle1").Range("M111")

Answer 1

我在互联网上找到了这个 - 我忘记了在哪里（可能是 stackoverflow） - 但它应该可以满足您的需求。 您可能想要编辑过多的消息，我发现它们有助于确保我复制粘贴我想要的范围。

Public 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

结束子

Answer 2

请尝试此代码。

Sub copythis(ByRef rFrom As Range, ByRef rTo As Range)
    Dim rVisible As Range
    Set rVisible = rFrom.SpecialCells(xlCellTypeVisible)
    rVisible.Copy destination:=rTo
End Sub

应该这样称呼：

Sub caller()
    copythis "range with hidden to be copied", "range to receive"
End Sub