Excel: Remplir une feuille de calcul avec des lignes correspondantes

Question

J'ai un classeur Excel qui est utilisé pour suivre les tâches par projet. Chaque projet a sa propre feuille de travail dans le classeur.

Dans chaque feuille de calcul, il existe des lignes pour chaque élément de travail et la première colonne contient le nom de la personne à laquelle l'élément de travail est affecté. Ces lignes ne sont pas triées par nom.

Je veux créer une feuille de calcul qui ira automatiquement à travers chacune des feuilles de calcul (autre que la feuille active) et tirer toutes les lignes assignées à une certaine personne.

Quelqu'un sait d'une macro VBA qui s'occupera de cela pour moi?

Answer 1

Cela devrait vous aider à démarrer:

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