Want to copy a string of text and a range of cells

[Tonkytonk]

Hi all,

I want to copy a string of text with a range of cells.

My old Macro worked until I have added my new code at the end. I have tried multiple different ways and none have worked.

Sub Macro2()
'


Dim MyString As String
Dim myrange As Range


MyString = "The following student need to complete a detention. Those that are highlighted, further consequences will apply if not completed today."

    ActiveWorkbook.Worksheets("Detention").ListObjects("Table5").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Detention").ListObjects("Table5").Sort.SortFields. _
        Add2 Key:=Range("Table5[_studentform]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Detention").ListObjects("Table5").Sort.SortFields. _
        Add2 Key:=Range("Table5[_StatusCaption]"), SortOn:=xlSortOnValues, Order _
        :=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Detention").ListObjects("Table5").Sort.SortFields. _
        Add2 Key:=Range("Table5[_fullname]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Detention").ListObjects("Table5").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("F2:S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

***New code***
   Set myrange = Selection

    Dim mytext As DataObject
    mytext = MyString & vbNewLine & myrange
    mytext.PutInClipboard
    
End Sub