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