Фильтрация данных в цикле и копирование данных на другой лист - Ошибка обработки # - PullRequest
1 голос
/ 11 мая 2019

Я передаю критерии фильтрации в цикле, чтобы отфильтровать данные в DataSheet и выбрать отфильтрованные данные из (Col C, если пользователь выбрал включение) или (Col D, если пользователь выбрал отключение), а также скопировать и вставить данные на другой лист .

Отфильтрованные данные могут быть больше 1 строки, поэтому я решил скопировать данные, найдя последнюю строку и написав код следующим образом: копирование только видимых ячеек

x = Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C" & x).SpecialCells(xlCellTypeVisible).Copy
OR
x = Cells(Rows.Count, "A").End(xlUp).Row
Range("D2:D" & x).SpecialCells(xlCellTypeVisible).Copy

этот код выдает мне ошибку, когда критерий фильтрации относится к первой строке в DataSheet, где вместо выделения одной строки данных он выбирает целые строки данных и выдает ошибку при вставке его в другой лист.

Run-time Error '1004':
We can't paste because the copy area and paste area aren't same size.

отлично работает по вторым критериям фильтрации

Возможное решение, которое я ищу : Поэтому вместо того, чтобы выделять весь столбец видимых данных, я ищу другой цикл внутри For..Next Loop, в котором он циклично перемещается только между видимыми ячейками и копирует данные в другой лист построчно.

Ниже приведен весь код:

Sub CommentGen_Auto()
Dim i As Long, n As Long, x As Long, lastrow As Long
Dim wb As Workbook


Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set wb = ThisWorkbook
wb.Worksheets("Filter").Select
Range("H3:H100").Clear

n = Cells(Rows.Count, "B").End(xlUp).Row

For i = 3 To n
wb.Worksheets("Filter").Select
Name = Cells(i, "B").Value
groupname = Cells(i, "C").Value
Action = Cells(i, "D").Value
class = Cells(i, "E").Value

wb.Worksheets("Data").Select
Range("A1").AutoFilter Field:=1, Criteria1:=Name
Range("A1").AutoFilter Field:=2, Criteria1:=groupname
Range("A1").AutoFilter Field:=5, Criteria1:=class

If Not IsEmpty(Action) Then
If Action = "Enable" Then
x = Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C" & x).SpecialCells(xlCellTypeVisible).Copy
Else
x = Cells(Rows.Count, "A").End(xlUp).Row
Range("D2:D" & x).SpecialCells(xlCellTypeVisible).Copy
End If

wb.Worksheets("Filter").Select
lastrow = Cells(Rows.Count, "I").End(xlUp).Row + 2
Range("I" & lastrow).PasteSpecial xlPasteAll

wb.Worksheets("Data").Select
Range("A1").AutoFilter
End If

Next
wb.Worksheets("Filter").Select
Range("A1").Select
End Sub

Таблица данных для фильтрации: DataSheet to Filter

Снимок ошибки: Error Snapshot

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...