Данные фильтра и значения копирования VBA

Question

Мой код, указанный ниже, должен фильтровать данные в wsData, а затем скопировать его в лист wsTest один за другим в столбце A. Код работает, за исключением того, что он копирует значения по каждому из листов назначения а не друг за другом. Любая идея почему?

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 

Answer 1

В первый момент: при использовании диапазона с AutoFiltercopy всегда исключает скрытые клетки

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

все, что вам нужно здесь.
Что касается вашей ошибки: On Error Resume Next скрывает ошибку i = wsTest.Range("A" & Rows.Count).End(xlUp), которая возвращает диапазон, а не числовое значение.

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

ваш друг здесь :)

Все вместе должно выглядеть примерно так:

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: Для исключения заголовков просто изменить:

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

в :

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

и если вы не хотите, все заголовки на всех, то непосредственно использовать:

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

Но нету тестировал. Просто скажите мне, если у вас возникнут какие-либо проблемы;)