VBA：range.copy不复制整个范围[重复]答案

【问题标题】：VBA: range.copy not copying the whole range [duplicate]VBA：range.copy不复制整个范围[重复]
【发布时间】：2022-01-07 18:10:55
【问题描述】：

我的数据表上有我用来过滤它的 A 列信息（10 到 13 之间的数字）。举例说明：

Number	Item
10	Apple
11	Blue
10	Orange
12	Carbon
13	Steve
10	Banana

继续。数千行。

我想根据 A 列的信息过滤表格，然后将粘贴复制到同一个工作簿中的新工作表中。代码：

ActiveWorkbook.Worksheets("Data").Range("A1").AutoFilter Field:=1, Criteria1:="10"
ActiveWorkbook.Worksheets("Data").Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
   ActiveWorkbook.Worksheets("Fruits").Range("A2")

我已经在多个项目中使用此代码并且一切正常，但我在上一个项目中遇到了问题。只有第一行和第二行被复制（在我的例子中只有 Apple 和 Orange 行）。有时它甚至只是复制标题和第一行数据。当我运行代码 (F5) 或调试它 (F8) 时，都会发生这种情况。我什至实现了一个延时中间过滤器和复制粘贴。没用。

奇怪的是，当我在调试过程中选择了一个随机单元格时，它起作用了。它复制了我需要的整行。所以我把代码改成

ActiveWorkbook.Worksheets("Data").Range("A1").AutoFilter Field:=1, Criteria1:="10"
Range("D2").Select
ActiveWorkbook.Worksheets("Data").Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
   ActiveWorkbook.Worksheets("Fruits").Range("A2")

那也没有用。我很困惑和迷失。任何帮助都会得到帮助。

编辑：实际代码：

With Workbooks("Conferência OPS (R5).xlsx").Worksheets("OPS (Ábaco)")
    .Range("A1").AutoFilter Field:=1, Criteria1:="10"
Workbooks("Conferência OPS (R5).xlsx").Worksheets("OPS (Ábaco)").Range("A2:H" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
    Workbooks("Conferência OPS (R5).xlsx").Worksheets("R10 (Ábaco x SOF)").Range("A2")

【问题讨论】：

要复制标题吗？

标签： excel vba filter copy

【解决方案1】：

复制过滤后的数据

Option Explicit

Sub CopyFilteredData()
     
    Dim wb As Workbook: Set wb = "Conferencia OPS (R5).xlsx"
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("OPS (Ábaco)")
    If sws.AutoFilterMode Then sws.AutoFilterMode = False
    
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' with headers
    Dim scrg As Range: Set scrg = srg.Columns("A:H") _
        .Resize(srg.Rows.Count - 1).Offset(1) ' without headers
    srg.AutoFilter Field:=1, Criteria1:="10"
    
    On Error Resume Next
        Dim svrg As Range: Set svrg = scrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    sws.AutoFilterMode = False
    
    Dim DataCopied As Boolean
    If Not svrg Is Nothing Then
        Dim dws As Worksheet: Set dws = wb.Worksheets("R10 (Ábaco x SOF)")
        Dim dfCell As Range: Set dfCell = dws.Range("A2")
        svrg.Copy dfCell
        DataCopied = True
    End If
        
    If DataCopied Then
        MsgBox "Data copied.", vbInformation, "CopyFilteredData"
    Else
        MsgBox "There was no filtered data.", vbExclamation, "CopyFilteredData"
    End If
     
End Sub

【讨论】：