Filter data and copy values VBA

Question

My code below is supposed to filter data in the wsData and then copy it into the wsTest worksheet after each other in column A. The code works except that it copies the values over each on the destination sheet rather then after each other. Any idea why?

Sub PrintReport()

Dim wbFeeReport As Workbook
Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim wsTest As Worksheet
Dim FrRngCount As Range
Dim i As Integer
Dim k As Integer
Dim t As Integer
Dim s As Integer



Set wbFeeReport = Workbooks("FeExcForm.xlsm")

Set wsData = wbFeeReport.Worksheets("Data")
Set wsTest = wbFeeReport.Worksheets("Test")

wsTest.Cells.Clear

wsData.Activate


i = 1

For k = 1 To 2

With ActiveSheet
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
 .AutoFilter 1, k
   On Error Resume Next
    .SpecialCells(xlCellTypeVisible).Copy Destination:=wsTest.Range("A" & i)
End With
i = wsTest.Range("A" & Rows.Count).End(xlUp)
.AutoFilterMode = False
End With

Next k

End Sub

Why the on error when using that you need another line later in the code that turn the error back on. on error goto 0 — Scott Craner
– Scott Craner, Commented Apr 21, 2016 at 1:19
Try Destination:=wsTest.Range("A" & i+1). Your calculation of i will come up with the last used row, not the first unused row. — OldUgly
– OldUgly, Commented Apr 21, 2016 at 1:19
Thanks for tips guys. @Scott Good to know, I will keep it in mind.@OldUgly I guess that was part of the issue. — VBA Pete
– VBA Pete, Commented Apr 21, 2016 at 16:09

Dirk Reichel · Accepted Answer · 2016-04-21 16:30:51Z

1

As first point: if using a range with AutoFilter the copy will always exclude the hidden cells

With Range("A1", Range("A" & Rows.Count).End(xlUp))
  .AutoFilter 1, k
  .Copy wsTest.Range("A" & i)
End With

is all you need here.
Regarding your error: On Error Resume Next hides the error of i = wsTest.Range("A" & Rows.Count).End(xlUp) which would return a range rather than a numerical value.

i = wsTest.Range("A" & Rows.Count).End(xlUp).Row + 1

is your friend here :)

Everything together should look something like that:

Sub PrintReport()

  Dim wbFeeReport As Workbook
  Dim wsData As Worksheet
  Dim wsForm As Worksheet
  Dim wsTest As Worksheet
  Dim FrRngCount As Range
  Dim i As Integer
  Dim k As Integer
  Dim t As Integer
  Dim s As Integer

  Set wbFeeReport = Workbooks("FeExcForm.xlsm")

  Set wsData = wbFeeReport.Worksheets("Data")
  Set wsTest = wbFeeReport.Worksheets("Test")

  wsTest.Cells.Clear
  wsData.Activate

  i = 1

  For k = 1 To 2
    With wsData
      .AutoFilterMode = False

      With .Range("A1", Range("A" & Rows.Count).End(xlUp))
        .AutoFilter 1, k
        .Copy wsTest.Range("A" & i)
      End With

      i = wsTest.Range("A" & Rows.Count).End(xlUp).Row + 1
      .AutoFilterMode = False
    End With
  Next k

End Sub

EDIT: For excluding headers just change:

.Copy wsTest.Range("A" & i)

to:

If i = 1 Then .Copy wsTest.Range("A" & i) Else .Offset(1, 0).Copy wsTest.Range("A" & i)

and if you do not want any headers at all then directly use:

.Offset(1, 0).Copy wsTest.Range("A" & i)

But I havent tested it. Just tell me if you get any problems ;)

edited Apr 21, 2016 at 16:30

answered Apr 21, 2016 at 1:38

Dirk Reichel

7,9991 gold badge18 silver badges31 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

VBA Pete Over a year ago

One more thing: is there a way to exclude the header from being copied over?

Dirk Reichel Over a year ago

@VBAPete pls try my edit and then tell me if it works the way you need it.

Collectives™ on Stack Overflow

Filter data and copy values VBA

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related