Копирование отфильтрованных ячеек и вставка значения только в отфильтрованные ячейки

Question

Мне известно, что я могу копировать отфильтрованные ячейки с помощью Ctrl - G (Go To) - Special - Visible Cells Only. Но я не могу скопировать отфильтрованные ячейки и вставить их в другой набор отфильтрованных ячеек.

Мне также известно, что мы можем использовать функцию Fill структурированной таблицы для заполнения вверх / вниз / влево вправо, и она будет пропускать скрытые ячейки. Но с этим методом я не могу наклеить отфильтрованные клетки на себя. И я должен скрыть столбцы / строки, которые находятся между исходным и целевым диапазонами. И это перезапишет форматирование ячеек назначения.

Любой метод (включая VBA), чтобы скопировать отфильтрованные ячейки и вставить значение только в другой набор отфильтрованных ячеек (они могут быть в том же диапазоне)?

Answer 1

Используя Msgbox, чтобы спросить пользователя, хочет ли он вставить только значение, и метод MyRange.Copy, я смог сделать это.

Sub CopyPasteVisibleCells()
'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
Dim ValueOnly As Integer

'You should turn off screen updating and calculations here to increase speed

ValueOnly = MsgBox("Do you want to paste value only (yes) or the entire cell content (No)?", vbQuestion + vbYesNo + vbDefaultButton2, "Choose what to paste")

Set RangeCopy = Selection

Set RangeDest = Application.InputBox("Select range to paste onto ", "Obtain Range Object", Selection.Address, 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 ValueOnly = vbYes Then 'If user wants to copy value only
    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
                RangeDest.Value = RangeCopy.Value
            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
            RangeDest(dstRow).Value = rng1.Value
            dstRow = dstRow + 1
        Next
    End If
Else 'If user wants to copy all cell content
    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
End If


Application.CutCopyMode = False

'You can turn back on screen updating and calculations here

End Sub