Question

基本上我是在处理案件的角色。

我想要做的是运行基于整页数据的脚本，如图1所示。我想复制包含审核日期的行，并将它们复制到同一工作簿中的另一个工作表中。

通常有大约7/8人的团队。所有工作人员都在同一个工作簿上。

我希望运行1个脚本，该脚本将为每个工作人员（来自同一工作簿中的每个单独的工作表）检索每个案例。然后检查包含案例的所有行，并在单独的工作表上整理所有数据。

我不希望任何人为8人制作代码，但即使我能指出正确的方向，这也是非常好的。

我意识到可以在复制之前过滤数据，但是必须锁定所有工作表，并且宏过滤器功能似乎不能在锁定的工作簿上工作...

提前致谢！

The original data

How I want the data to show.

Answer 1

@Alistair Macintyre ........这是一个循环遍历1张数据的示例。现在你所需要的只是代码，它将遍历工作簿中的所有工作表.....祝你好运

Sub Move_data()

    Dim r As Integer
    Dim ResRow As Integer

    r = 2
    ResRow = 2

    Do Until Len(Trim(Cells(r, 1))) = 0

        DoEvents

        If Len(Trim(Cells(r, 7))) > 0 Then

            Worksheets("Review").Cells(ResRow, 1) = Trim(Cells(r, 1))
            Worksheets("Review").Cells(ResRow, 2) = Trim(Cells(r, 2))
            Worksheets("Review").Cells(ResRow, 3) = Trim(Cells(r, 3))
            Worksheets("Review").Cells(ResRow, 4) = Trim(Cells(r, 4))
            Worksheets("Review").Cells(ResRow, 5) = Trim(Cells(r, 5))
            Worksheets("Review").Cells(ResRow, 6) = Trim(Cells(r, 6))
            Worksheets("Review").Cells(ResRow, 7) = Trim(Cells(r, 7))
            Worksheets("Review").Cells(ResRow, 8) = Trim(Cells(r, 8))

            ResRow = ResRow + 1

        End If

        r = r + 1

    Loop

    MsgBox "Done"

End Sub

如果输入任何日期，则使用VB或宏将特定行复制到另一个工作表

1 个答案: