Attach worksheet to email

[micko1]

Need some help with this one. I have a workbook that has a summary page of all vehicles and compliance checks associated with each vehicle. When the dates come within a set range an email is sent to the appropriate person. Column "F" ie rngCell.Offset(0, 5) has all the registration numbers in it. Each worksheet is named after the registration numbers. So in essence Column "F" is a list of all worksheets. What I would like is for the worksheet to be attached to the email. This is the code that sends the email.
Thanks for taking the time to look.

Sub Rego_Due_Month()
    Dim rngCell As Range
    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailSubject As String
    Dim EmailSendTo As String
    Dim MailBody As String
    Dim EmailRecipient As String
    Dim SigString As String
    Dim Signature As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    With ActiveSheet
    If .FilterMode Then .ShowAllData
    
    Set Rng = .Range("A7", .Cells(.Rows.Count, 1).End(xlUp))
  End With
    
    For Each rngCell In Rng
    If rngCell.Offset(0, 13) > 0 Then
    
'Registration due date 30 days from Due date
    
          ElseIf rngCell.Offset(0, 6) > Evaluate("Today() +7") And _
          rngCell.Offset(0, 6).Value <= Evaluate("Today() +30") Then
                rngCell.Offset(0, 13).Value = Date
         
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
    strbody = "Dear  " & rngCell.Value & vbNewLine & vbNewLine & _
              "Vehicle " & rngCell.Offset(0, 5).Value & " registration is due for renewal on " & rngCell.Offset(0, 6).Value & " please arranged inspection at your earliest convenience." & vbNewLine & vbNewLine & vbNewLine & _
              "Thank you for your co-operation in this matter." & vbNewLine & vbNewLine & vbNewLine & _
              
              
    EmailSendTo = Replace(rngCell.Hyperlinks(1).Address, "mailto:", "")
    EmailSubject = "Vehicle Registrations Due"
    EmailRecipient = rngCell.Value
    

    On Error Resume Next
    With OutMail
        .To = EmailSendTo
        .CC = "[EMAIL="admin@test.com.au"]admin@test.com.au[/EMAIL]"
        .BCC = ""
        .Subject = EmailSubject
        .Body = strbody
        
        .Display  
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    

End If
Next rngCell
End Sub