Excel：使用匹配的行填充工作表

I have an excel workbook that is used to track tasks by project. Each project has its own worksheet in the workbook.

我有一个excel工作簿,用于按项目跟踪任务。每个项目在工作簿中都有自己的工作表。

Within each worksheet, there are rows for each work item, and the first column contains the person's name that the work item is assigned to. These rows are not sorted by name.

在每个工作表中,每个工作项都有行,第一列包含工作项分配给的人员名称。这些行不按名称排序。

I want to create a worksheet that will automatically go through each of the worksheets (other than the active sheet) and pull in all rows assigned to a certain person.

我想创建一个工作表,它将自动浏览每个工作表(活动工作表除外)并拉入分配给某个人的所有行。

Anyone know of a VBA Macro that will take care of this for me?

有人知道VBA宏会为我照顾吗?

1 个解决方案

#1

This should get you started:

这应该让你开始:

Option Explicit

'// change this name to generate a report for a different user //'
Const activeUser = "Alex"

'// change these values to fit your data //'
Const maxTasks = 100
Const maxCols = 10

Public Sub BuildSummary()
    Dim projectIndex As Integer
    Dim projectSheet As Worksheet
    Dim taskIndex As Integer
    Dim summaryRow As Integer

    summaryRow = 1
    For projectIndex = 1 To ActiveWorkbook.Worksheets.Count
        Set projectSheet = ActiveWorkbook.Worksheets(projectIndex)
        If projectSheet.Index <> ActiveSheet.Index Then

            '// insert a row with the name of the project //'
            ActiveSheet.Cells(summaryRow, 1).Value = projectSheet.Name
            summaryRow = summaryRow + 1

            '// search for the active user in each task //'
            For taskIndex = 1 To maxTasks
                If projectSheet.Cells(taskIndex, 2).Value = activeUser Then

                    '// copy the relevant rows to the summary sheet //'
                    projectSheet.Range(projectSheet.Cells(taskIndex, 1), _
                        projectSheet.Cells(taskIndex, maxCols)).Copy
                    ActiveSheet.Range(ActiveSheet.Cells(summaryRow, 1), _
                        ActiveSheet.Cells(summaryRow, maxCols)).Select
                    ActiveSheet.Paste
                    summaryRow = summaryRow + 1
                End If
            Next taskIndex
        End If
    Next projectIndex

    ActiveSheet.Cells(1, 1).Select
End Sub