Excel: заполнить лист соответствующими строками

Question

У меня есть книга Excel, которая используется для отслеживания задач по проектам. Каждый проект имеет свою рабочую таблицу в рабочей книге.

Внутри каждого рабочего листа есть строки для каждого рабочего элемента, а в первом столбце содержится имя человека, которому назначен рабочий элемент. Эти строки не отсортированы по имени.

Я хочу создать рабочий лист, который будет автоматически проходить через каждый из рабочих листов (кроме активного листа) и вытягивать все строки, назначенные определенному человеку.

Кто-нибудь знает макрос VBA, который позаботится об этом для меня?

Answer 1

Это должно помочь вам начать:

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