CODEWITHSUNDEEP
vbaexcel
VBA Pete
VBA Pete

Reputation: 2666

Filter data and copy values VBA

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

Upvotes: 0

Views: 128

Answers (1)

Dirk Reichel
Dirk Reichel

Reputation: 7979

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

Upvotes: 1

Related Questions