1

My data sheet has on the A column info (numbers between 10 to 13) which I use to filter it. To illustrate:

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

Goes on. Thousands of rows.

I want to filter the table based on the info on column A, then copy paste into a new sheet, in the same workbook. The code:

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")

I've been using this code for a number of projects and all worked fine, but I'm having issues in my last one. Only the first and second row are being copying (only Apple and Orange rows in my exemple). Sometimes it's even copying just the header and the first row of data. It's happening both when I run the code (F5) or debug it (F8). I even implemented a time delay mid filter and copy-paste. Didn't work.

Weirdly enough, when I selected a random cell mid debug it worked. It copy the entire rows that I needed. So I change the code to

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")

That didn't worked either. I'm confused and lost. Any help would be appriciated.

EDIT: The actual code:

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")

1 Answers1

0

Copy Filtered Data

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28