Как скопировать один указанный столбец c после фильтрации результатов с помощью автофильтра - VBA - PullRequest
0 голосов
/ 23 апреля 2020

Я остро нуждаюсь в помощи после нескольких часов попыток. Я новичок в VBA, и это моя проблема. У меня есть таблица с 20 столбцами (от A до T), но с неопределенным количеством строк (они будут добавляться со временем), моя цель состоит в том, чтобы отфильтровать данные по 2 критериям: первый критерий находится в столбце 6 (F2) - город Имя и второй критерий находятся в столбце 11 (K2) - месяц, но не отформатирован как время, просто текст, после этого я хочу скопировать только видимые результаты столбца 20 (T2) на второй лист рабочей книги. Проблема для меня заключается в том, что при запуске кода все столбцы копируются (от A до T). Вот код, который я использовал:

Sub copy_filtered_data()
Dim count_col, count_row As Integer
Dim orig, output As Worksheet


Worksheets("Intrari").Activate

Set orig = ThisWorkbook.Sheets("Intrari")
Set output = ThisWorkbook.Sheets("Raport")

count_col = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))

ActiveSheet.Range("A1").AutoFilter Field:=6, Criteria1:=Cells(2, 28).Value
ActiveSheet.Range("A1").AutoFilter Field:=11, Criteria1:=Cells(2, 29).Value

orig.Range("T1") = Cells(count_row, 20).SpecialCells(xlCellTypeVisible).Copy
output.Cells(1, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

Заранее спасибо:)

1 Ответ

0 голосов
/ 23 апреля 2020

Здесь есть несколько проблем, которые могут вызывать у вас проблемы, включая неквалифицированные диапазоны, синтаксические проблемы и не типизированные переменные. Попробуйте следующий код.

Sub copy_filtered_data()

Dim orig as Worksheet, output As Worksheet

Set orig = ThisWorkbook.Sheets("Intrari")
Set output = ThisWorkbook.Sheets("Raport")

Dim count_col as Long, count_row As Long

count_col = orig.Cells(1,orig.Columns.Count).End(xlToLeft).Column
count_row = orig.Cells(orig.Rows.Count,1).End(xlUp).Row

orig.Range("A1").AutoFilter Field:=6, Criteria1:=orig.Cells(2, 28).Value
orig.Range("A1").AutoFilter Field:=11, Criteria1:=orig.Cells(2, 29).Value

orig.Range("T1:T" & count_row).SpecialCells(xlCellTypeVisible).Copy
output.Cells(1, 1).PasteSpecial xlPasteValues

End Sub
...