VBA – PasteSpecial使用SpecialCells.Copy后不工作

我经历了很多线索，但没有一个能够解决我的问题。

总之，我尝试从工作簿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的解决scheme去遍历过滤范围的所有区域：

  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提到的是非常真实的，如果它们Non Contiguous ，则不能在过滤的范围上使用Paste Special 。 但是有一种方法可以实现你想要的:)

您必须遍历过滤范围的每个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 ，因为你只需要值，你可以设置范围等于eachother。

 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 ，它只是把你的复制范围内的第一个值放在单元格中。 您需要将目标范围扩大到复制范围的大小。