Try this

Public Sub ExtractAcNumbers()
Dim wsShareholders As Worksheet
Dim wsFinal As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wsShareholders = Worksheets("Shareholders")
    Set wsFinal = Worksheets("Final")
    
    With wsFinal
    
        nextrow = 1
        With .Cells(nextrow, "A")
        
            .Value = "Dealer Account Number"
            .Font.Bold = True
            .Font.Underline = True
        End With
    End With
    
    With wsShareholders
        
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
        
            If Left$(.Cells(i, "A").Value, 9) = "(DLR A/C:" Then
            
                nextrow = nextrow + 1
                wsFinal.Cells(nextrow, "A").Value = Mid$(.Cells(i, "A").Value, 10, Len(.Cells(i, "A").Value) - 10)
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub