Vba 复制粘贴筛选数据未按预期工作

第一件事。我对VBA很陌生。 其次，我在谷歌上搜索了我的屁股，我真的没有找到它的底部。主要是因为代码是根据我做的谷歌搜索（复制/粘贴代码）来适应我的需要的

解决我的问题。我有一个表（原始数据），其中有很多列（a:AN）和很多行（160000），它们会不时更新。我想根据几列（a和B）中的条件过滤数据集，并从a列开始将数据复制/粘贴到不同的工作表（散点原始数据）中。我也不想从“原始数据”中复制标题，并开始粘贴在标题->下面的“散点表”中（在本例中为2行）

我现在有两个问题：

根据我使用的过滤器，我将在“原始数据”中获得17267行。如果我只是简单地进行选择和复制，那么我只复制过滤后的数据。但当我以某种方式粘贴数据时，我突然得到18362行，即使它们是空的。我可以从滚动条下降的事实看出这一点。我使用这种复制方式是因为有时我希望能够根据在不同单元格中设置的值附加复制的数据。我做错了什么，或者发生了什么

工作簿中有更多的工作表。如果未选择原始数据工作表，则在“Set rng=”行上会出现类似“应用程序定义或对象定义错误”的错误，但我没有看到。在其他测试中，我也得到了一个不同的错误，但那是因为范围是基于活动表，而不是我需要的。既然过滤器设置正确，为什么会发生这种情况

第N列中的值应全部除以1000。我想我没有其他方法，然后使用一个临时复制列，在一个新列中除以1000，然后将新值复制/粘贴到我需要的位置，对吗

最后一点，代码在一个模块中运行，稍后将分配给一个按钮

Sub Copy()
  Dim destTrSheet As Worksheet
  Dim sctrSheet As Worksheet

  Set destTrSheet = ThisWorkbook.Worksheets("Data Raw")
  Set sctrSheet = ThisWorkbook.Worksheets("Scatter Raw")

  With destTrSheet
    .Range("A:A").AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
    .Range("B:B").AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues

    Set Rng = .Range("N2").Resize(Cells(Rows.count, "N").End(xlUp).Row - 1)
    Rng.Copy
    sctrSheet.Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)

    Set Rng = .Range("X2").Resize(Cells(Rows.count, "N").End(xlUp).Row - 1)
    Rng.Copy
    sctrSheet.Range("B" & Rows.count).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
  End With

End Sub

---

你提到的问题

手动复制和代码复制之间的差异可能由使用的偏移量引起：

• 列A

  .Offset（1，0）。将特殊的
  -1行粘贴到上次使用的行下方

• 列B

  。偏移量（2，0）。将特殊的
  -粘贴到上次使用的行下方的2行

该错误是由

.Range（“N2”）

vs

（单元格（Rows.count，“N”）

• .Range（“N2”）

  由于点（
  ）而被明确限定-指的是

  “原始数据”

• 单元格（Rows.count，“N”）

  隐式引用的是

  ActiveSheet

  （缺少
  ）

如果列N应除以1000

• 是的，可以使用helper列，如下面的代码中所示
• 另一种方法：将列复制到数组中，除以每个值，然后将其粘贴回去

如果N列包含字符串，则除法将生成单元格错误：

---

---

其他问题

• 子名称（

  Copy（）

  ）与内置的

  范围.Copy

  方法之间可能存在冲突
• 两个自动筛选行无效

  • .Range（“A:A”）。自动筛选字段：=1，标准1:=VF，运算符：=xlFilterValues

  • .Range（“B:B”）。自动筛选字段：=2，标准1:=CITY，运算符：=xlFilterValues

  • 如果你的代码有效，你可能会在发布问题时修改它；它们应该是

  • .Range（“A:B”）。自动筛选字段：=1，标准1:=VF，运算符：=xlFilterValues

  • .Range（“A:B”）。自动筛选字段：=2，标准1:=CITY，运算符：=xlFilterValues

• .PasteSpecial（xlPasteValues）

---

你好，保罗。非常感谢你的回答和解释。1）你可能是对的。我在第二份副本上使用了偏移量2，因为B列没有标题->我的判断正确吗？。无论如何，现在我也在B列中添加了一个标题，并用偏移量1对两列进行了测试->在复制的数据末尾没有更多空格2）我承认我读过这方面的内容，并做了一些尝试，但没有使用（.Cells），而是使用了以前的灰色工作表名称“.在某个地方我一定做错了什么，因为它也没有按预期工作->现在工作3）我会尝试你的解决方案。但我还不熟悉数组以及它们是如何工作的->将深入研究它。4） Sub（Copy）名称就是为了这个帖子，我实际上使用Sub test_Data（）。5） 我没有改变自动过滤线路上的任何东西，它们正在工作。嗨，保罗。我在使用你的代码时遇到了一个新问题。也许你能帮忙。我将在下面发布我的问题的答案，因为它的文字太多了。

Option Explicit

Public Sub CopyRawToScatter()
    Dim wsR As Worksheet:       Set wsR = ThisWorkbook.Worksheets("Data Raw")
    Dim wsS As Worksheet:       Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
    Dim lrR As Long:            lrR = wsR.Cells(wsR.Rows.Count, "A").End(xlUp).Row
    Dim lrS As Long:            lrS = wsS.Cells(wsS.Rows.Count, "A").End(xlUp).Row + 1
    With wsR
        Dim fRng As Range:      Set fRng = .Range(.Cells(1, "A"), .Cells(lrR, "B"))
        Dim rngN As Range:      Set rngN = .Range(.Cells(2, "N"), .Cells(lrR, "N"))
        Dim rngX As Range:      Set rngX = .Range(.Cells(2, "X"), .Cells(lrR, "X"))
        Dim cRng As Range:      Set cRng = Union(rngN, rngX)
    End With

    Application.ScreenUpdating = False
    fRng.AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
    fRng.AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues

    If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
        cRng.Copy
        wsS.Cells(lrS, "A").PasteSpecial xlPasteValues
        With wsS
            Dim vis As Long:    vis = .Cells(.Rows.Count, "A").End(xlUp).Row
            Dim lcS As Long:    lcS = .Cells(lrS, "A").End(xlToRight).Column + 1
            Dim divA As Range:  Set divA = .Range(.Cells(lrS, "A"), .Cells(vis, "A"))
            Dim divX As Range:  Set divX = .Range(.Cells(lrS, lcS), .Cells(vis, lcS))

            divX.Formula = "=" & .Cells(lrS, 1).Address(RowAbsolute:=False) & " / 1000"
            divA.Value2 = divX.Value2
            divX.ClearContents
        End With
    End If
    wsR.UsedRange.AutoFilter
    Application.ScreenUpdating = False
End Sub