Counting names

ftb1ss 

Here is a macro that you can use. Change the constants at the beginning to match your setup.

The macro will create a summary sheet if it doesn't exist, otherwise it will overwrite its contents.

Sub ListNames()
    ' Change the constants as needed
    Const strSummary = "Summary" ' Name of the summary sheet
    Const FNCol = "A" ' First Name column
    Const LNCol = "B" ' Last Name column
    Const IDCol = "C" ' ID column
    Dim dctFN As Object
    Dim dctLN As Object
    Dim dctID As Object
    Dim wsh As Worksheet
    Dim wss As Worksheet
    Dim r As Long
    Dim m As Long
    Dim varID As Variant
    Application.ScreenUpdating = False
    Set dctFN = CreateObject(Class:="Scripting.Dictionary")
    Set dctLN = CreateObject(Class:="Scripting.Dictionary")
    Set dctID = CreateObject(Class:="Scripting.Dictionary")
    On Error Resume Next
    Set wss = Worksheets(strSummary)
    On Error GoTo 0
    If wss Is Nothing Then
        Set wss = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        wss.Name = strSummary
    Else
        wss.Cells.Clear
    End If
    wss.Range("A1:D1").Value = Array("First Name", "Last Name", "ID", "Count")
    For Each wsh In Worksheets
        If wsh.Name <> strSummary Then
            m = wsh.Range(IDCol & wsh.Rows.Count).End(xlUp).Row
            For r = 2 To m
                varID = wsh.Range(IDCol & r).Value
                If dctID.Exists(varID) Then
                    dctID(varID) = dctID(varID) + 1
                Else
                    dctID.Add Key:=varID, Item:=1
                    dctFN.Add Key:=varID, Item:=wsh.Range(FNCol & r).Value
                    dctLN.Add Key:=varID, Item:=wsh.Range(LNCol & r).Value
                End If
            Next r
        End If
    Next wsh
    wss.Range("A2").Resize(dctID.Count) = Application.Transpose(dctFN.Items)
    wss.Range("B2").Resize(dctID.Count) = Application.Transpose(dctLN.Items)
    wss.Range("C2").Resize(dctID.Count) = Application.Transpose(dctID.Keys)
    wss.Range("D2").Resize(dctID.Count) = Application.Transpose(dctID.Items)
    wss.Range("A1:D1").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub