I have the below code, how can I also add in a CC receipient from cell 6 in
the row

Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 5
'
Email = Cells(r, 2)

' Message subject
Subj = "Overdue Fire Inspection Report"

' Compose the message
Msg = ""
Msg = Msg & "Sir/Ma'am, " & vbCrLf & vbCrLf
Msg = Msg & "Report for facility " & Cells(r, 3).Text & " is overdue
by "
Msg = Msg & Cells(r, 4).Text & " days." & vbCrLf & vbCrLf
Msg = Msg & "If you have any questions, please contact our office at
" & vbCrLf & vbCrLf & vbCrLf
Msg = Msg & "" & vbCrLf
Msg = Msg & "Prevention Section"

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next r
End Sub