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提到的内容非常正确，如果它们是Paste Special，则您无法在过滤范围内使用Non Contiguous。但是有一种方法可以达到你想要的效果：）

您必须遍历已过滤范围的每个area，然后使用Paste Special，如下所示

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

在行动

Answer 2

PasteSpecial不适用于不连续的范围。如果在可见行中有一个隐藏的行，那么您有一个不连续的范围。但是，由于不连续范围的性质，直接复制和粘贴将粘贴格式和公式中的值;即它无法确定如何在公式中移动单元格范围，因此它只是粘贴值。

With originSheet
    .AutoFilterMode = False
    With .Range("A7:AA" & lastRowOriginSheet)
        .AutoFilter Field:=2, Criteria1:=projectNumber
        'you should probably check to ensure you have visible cells before trying to copy them
        .SpecialCells(xlCellTypeVisible).Copy destination:=destinationSheet.Range("B4")
    End With
End With

Answer 3

试试这个。不需要执行PasteSpecial，因为您只需要值，您可以将范围设置为彼此相等。

Dim copyRng As Range
With originSheet
    .AutoFilterMode = False
    With .Range("A7:AA" & lastRowOriginSheet)
        .AutoFilter Field:=2, Criteria1:=projectNumber
        Set copyRng = .SpecialCells(xlCellTypeVisible)
    End With
End With
' destinationSheet.Range("B4").Value = copyRng.Value
With destinationSheet
    .Range(.Cells(4, 2), .Cells(4 + copyRng.Rows.Count - 1, 2 + copyRng.Columns.Count - 1)).Value = copyRng.Value
End With

（假设您的工作表和lastRow以及projectNumber都已正确声明并正常工作）。

编辑，因为如果您只是Range("B4").Value = Range("A1:Z100").Value，它只会将第一个值放在单元格的复制范围内。您需要将目标范围扩展为复制范围的大小。

VBA - 使用SpecialCells.Copy后，PasteSpecial无法正常工作

3 个答案: