Copy Column A data to Sheet 2 where rows matches Sheet 2 headers

Assuming row 1 in sheet2 will be populated with the department names rather than need to determine the uniques from sheet1. Also assumed existence of header in sheet 1.

Sub SomeMacroName()
Dim ws1 As Worksheet:   Set ws1 = Sheets("sheet1")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Sheet2")
Dim c As Range
Dim rng As Range

Application.ScreenUpdating = False

Set rng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(1, ws2.Cells(1, Columns.Count).End(xlToLeft).Column))

For Each c In rng
    If Len(c) > 0 Then
        With ws1
            .AutoFilterMode = False
            .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).AutoFilter 1, c
            .Range("A2:A" & .Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy c.Offset(1)
            .AutoFilterMode = False
        End With
    End If
Next c

Application.ScreenUpdating = True

End Sub