Question

我目前在循环浏览已过滤的列表时遇到了我的代码，从行中选择并复制某些单元格并将其粘贴到另一张表格中。

我的代码如下：

Dim LastCol As Long
Dim iRow As Integer
Dim iRow2 As Integer

LastCol = Cells(5, Columns.Count).End(xlToLeft).Column + 1
For iRow = 2 To wb1.Sheets("1").Cells(Rows.Count, "A").End(xlUp).Row
For iRow2 = 6 To wb1.Sheets("n").Cells(Rows.Count, "A").End(xlUp).Row
    If wb1.Sheets("n").Cells(iRow2, d8).Value > End_Date Then
        If wb1.Sheets("n").Cells(iRow2, LastCol).Value <> "x" Then
            wb1.Sheets("n").Range("Cells(iRow2, d1), Cells(iRow2, d2), Cells(iRow2, d3), Cells(iRow2, d4), Cells(iRow2, d5), Cells(iRow2, d6), Cells(iRow2, d7)").Select
            wb1.Sheets("n").Range(Cells(iRow2, d7)).Activate
            Selection.Copy
            wb1.Activate
            wb1.Sheets("1").Cells(iRow, d21).PasteSpecial
            wb1.Sheets("n").Cells(iRow2, LastCol).Value = "x"
        Exit For
        End If
    End If
Next iRow2
Next iRow

结束_ 日期值因用户输入而异。

Answer 1

请注意，您必须在每个循环中重新计算PasteRow才能知道您应该粘贴的位置。

澄清之后，这是您的代码：

Sub test_Smer()

Dim LastCol As Long, _
    wsN As Worksheet, _
    ws1 As Worksheet, _
    LastRow As Long, _
    PasteRow As Long, _
    iRow As Long, _
    CopyRange As String

Set wsN = wb1.Sheets("n")
Set ws1 = wb1.Sheets("1")
LastCol = wsN.Cells(5, Columns.Count).End(xlToLeft).Column + 1
LastRow = wsN.Cells(wsN.Rows.Count, "A").End(xlUp).Row


With wsN
    For iRow = 6 To LastRow
        If .Rows(iRow).EntireRow.Hidden Then
        Else
            If .Cells(iRow, d8).Value > end_date Then
                If wsN.Cells(iRow, LastCol).Value <> "x" Then
                    CopyRange = Replace(.Cells(iRow, d1).Address & "," & _
                        .Cells(iRow, d2).Address & "," & _
                        .Cells(iRow, d3).Address & "," & _
                        .Cells(iRow, d4).Address & "," & _
                        .Cells(iRow, d5).Address & "," & _
                        .Cells(iRow, d6).Address & "," & _
                        .Cells(iRow, d7).Address, "$", "")
                    .Range(CopyRange).Copy

                    PasteRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1
                    ws1.Cells(PasteRow, d21).PasteSpecial

                    .Cells(iRow, LastCol).Value = "x"
                    Exit For
                Else
                End If
            Else
            End If
        End If
    Next iRow
End With

End Sub

如何循环过滤列表

1 个答案: