根据另一个单元格中的值提取特定记录

Question

I am reaching out again since I got great help last time. I have a worksheet that I import daily. I would like it to loop through the names in col B and paste the records for that employee in another sheet and to name that sheet the employee's name (ie John Doe). I would like to have each employee listed on their own named sheet with only those records associated with their name. I will generate a report for each employee from their sheet.

Here is the code I got so far:

 Sub GetEmployeeLines()
    Const STARTING_ROW As Long = 2
    Dim c As Long: c = STARTING_ROW
    Dim lr As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    lr = ActiveSheet.Range("B2:B1000").End(xlUp).Row
    
    Dim cell As Range
    For Each cell In Sheets("RawData").Range("B2:B" & lr).Cells
        If cell <> "" Then
            Sheets("DiscrepencyForm").Range("C:F").Rows(c).Value = cell.EntireRow.Columns(3).Resize(, 4).Value
            c = c + 1
        End If
    Next
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    End Sub

I have also attached a screenshot of my dataset.

Answer 1

If I understand you correctly, I think using a pivot table can give a similar result with the one you expected. The difference is, (A) with the one that you want of the VBA result ---> you select the sheet name to make your report.... (B) with a pivot table (no VBA) ---> you select the name in the Employee field of the pivot table.

Anyway, the test sub below maybe can get you start:

Sub test()
Dim rgSource As Range: Dim rgHdr As Range:
Dim rg As Range: Dim cell As Range
Dim arr: Dim el

'set the range of the name in sheet RawData into rgSource variable
'set the column header needed to be on each created sheet as rgHdr variable
With Sheets("RawData")
Set rgSource = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set rgHdr = .Range("C1:F1")
End With

'get each unique name in rgSource as arr variable
Set arr = CreateObject("scripting.dictionary")
For Each cell In rgSource: arr.Item(cell.Value) = 1: Next

'loop to each element (the unique name) in arr as variable el
For Each el In arr

    'get the range of cell with that name (the looped el value) as rg variable
    With rgSource
    .Replace el, True, xlWhole, , False, , False, False
    Set rg = .SpecialCells(xlConstants, xlLogical)
    .Replace True, el, xlWhole, , False, , False, False
    End With
    
    'set the range of rg from column C to F
    Set rg = rg.Resize(rg.Rows.Count, rgHdr.Columns.Count).Offset(0, 1)

    'create new sheet, name it with the name (the looped el value)
    'then put the rgHdr and the rg value into the new sheet
    With Sheets.Add
        .Name = el
        .Range("A1").Resize(1, rgHdr.Columns.Count).Value = rgHdr.Value
        .Range("A2").Resize(rg.Rows.Count, rgHdr.Columns.Count).Value = rg.Value
    End With

'loop to next el (the next name)
Next el
End Sub