VBA - 使用 SpecialCells.Copy 后 PasteSpecial 不起作用

Question

总而言之，我尝试将一些过滤后的数据从工作簿 A 复制到工作簿 B，并保持工作簿 B 的格式。

这是我的代码的相关部分:

With originSheet
    .AutoFilterMode = False
    With .Range("A7:AA" & lastRowOriginSheet)
        .AutoFilter Field:=2, Criteria1:=projectNumber
        .SpecialCells(xlCellTypeVisible).Copy
    End With
End With
destinationSheet.Range("B4").PasteSpecial xlPasteValues

特殊粘贴不起作用，这是使用的工作簿 A 的格式。

<小时/>

已解决:

问题是您不能在不连续的范围内使用 PasteSpecial。

所以我采用了 Siddharth Rout 的解决方案来遍历过滤范围的所有区域:

        With originSheet
            .AutoFilterMode = False

            With .Range("A7:AA" & lastRowOriginSheet)
                .AutoFilter Field:=2, Criteria1:=projectNumber

                Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)

                '~~> Loop through each area
                For Each area In filteredRange.Areas
                    With destinationSheet
                        '~~> Find Next available row
                        lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1

                        area.Copy
                        destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
                    End With
                Next area
            End With
        End With

Answer 1

@Jeeped 提到的非常正确，如果过滤范围是非连续，则不能在过滤范围上使用选择性粘贴。但是有一种方法可以实现您想要的:)

您必须循环遍历过滤范围的每个区域，然后使用选择性粘贴，如下所示

Sub Sample()
    Dim ws As Worksheet
    Dim lastRowOriginSheet As Long
    Dim filteredRange As Range, a As Range
    Dim projectNumber As Long

    '~~> I have set these for testing. Change as applicable
    projectNumber = 1
    Set ws = Sheet1
    Set destinationSheet = Sheet2
    lastRowOriginSheet = 16

    With ws
        .AutoFilterMode = False

        With .Range("A7:AA" & lastRowOriginSheet)
            .AutoFilter Field:=2, Criteria1:=projectNumber

            Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)

            '~~> Loop through each area
            For Each a In filteredRange.Areas
                With destinationSheet
                    '~~> Find Next available row
                    lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1

                    a.Copy
                    destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
                End With
            Next a
        End With
    End With
End Sub

实际行动