excel - 循环过滤数据并将数据复制到其他工作表 - 处理错误#

Question

我在循环中传递过滤条件以过滤 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 循环中寻找另一个循环，它仅在可见单元格之间循环，并将数据逐行复制到另一个工作表。

以下是整个代码：

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

要过滤的数据表：

错误快照：

标签： excelvbaloopsfiltering