Macro to email workbook to different recipients

The problem seems to be in the line

.to = ActiveSheet.Range("m2")

The current 'sh' from the SourceWb was never activated, and its copy in the new workbook is no longer active because DestWb is already closed. Therefore the ActiveSheet should be the one in SourceWb which was active when you started the code.

I have gone through your code and made some comments. Not all of them are very useful but since I did the work please look for a benefit from it, if you like. :-). I also added the variable string "Addressee" and assigned the value from M2 of the 'sh' to it, using 'Addressee' then to fill the 'To' field.

Sub Split_To_Workbook_and_Email()
    ' 11 Nov 2017
    'Working in 2013/2016
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String
    Dim myOutlook As Object
    Dim myMailItem As Object
    Dim Addressee As String
    Dim mySubject As String
    Dim myPath As String
    Dim strbody As String
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Set otlApp = CreateObject("Outlook.Application")
    mySubject = "GDPR and your contacts - please read "
    'Copy every sheet from the workbook with this macro
    Set Sourcewb = ActiveWorkbook
    'Create new folder to save the new files in
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = "f:\OnePlace\Strategy\GDPR\Primary Contact\" & Sourcewb.Name & " " & DateString
    MkDir FolderName
    'Copy every visible sheet to a new workbook
    For Each sh In Sourcewb.Worksheets
        'If the sheet is visible then copy it to a new workbook
        If sh.Visible = -1 Then
            Addressee = sh.Cells(2, "M").Value
            sh.Copy
            'Set Destwb to the new workbook
            Set Destwb = ActiveWorkbook
            With Destwb
                'Determine the Excel version and file extension/format
                If Val(Application.Version) < 12 Then
                    'You use Excel 97-2003
                    FileExtStr = ".xls"
                    FileFormatNum = -4143
                Else
                    'You use Excel 2007-2016
                    If Sourcewb.Name = .Name Then
                        ' === You are comparing the workbook name with the worksheet name !!!
                        MsgBox "Your answer is NO in the security dialog"
                        GoTo GoToNextSheet
                    Else
                        FileExtStr = ".xlsx"
                        FileFormatNum = 51
                    End If
                End If
            End With
            ' Change all cells in the worksheet to values
            If Destwb.Sheets(1).ProtectContents = False Then
                With Destwb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    
                    ' ambiguous coding:-
                    ' you can only select a cell in the ActiveSheet.
                    ' Therefore Destwb.Sheets(1) must be active.
                    .Cells(1).Select
                    ' the next command refers to the Activesheet
                    ' (observer the missing period in the lead!)
                    Cells.EntireColumn.AutoFit
                    ' if this code will only work on the ActiveSheet,
                    ' why call it Destwb.Sheets(1) ????
                End With
                Application.CutCopyMode = False
            End If
            'Save the new workbook, email it, and close it
            With Destwb
                .SaveAs FolderName _
                        & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                        FileFormat:=FileFormatNum
'                myPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
                myPath = Destwb.FullName
'            With Destwb
                .Close False
            End With
            Set otlNewMail = otlApp.CreateiItem(olMailItem)
            With otlNewMail
                strbody = "As part of GDPR requirements we need to seek approval from our contacts to market to them our events and briefings. As a result, we are currently checking in with fee-earners to confirm their contact spread at their clients." & vbNewLine & _
                "I am contacting you regarding the contacts we hold for the attached company as based on our records you have billed the client in the last 2 years. At this stage, please can you collectively review the contacts in the attached file and respond to me by COB 22/11/17 with the following information:" & vbNewLine & _
                "1.  Validating current contacts - please enter a Y/N in the relevant column to determine whether we keep should keep these contacts on the system (i.e. if you still have contact with them / they are still at the entity concerned);" & vbNewLine & _
                "2.  Primary Contact - please enter one name here which will enable you to be informed of their preferences when they reply, be informed periodically of how we are marketing to them / their interests and importantly be the primary contact for the respective individual should someone in the firm wish to follow-up with you directly about that contact; and" & vbNewLine & _
                "3.  Additions - if there are any contacts you collectively have as a team not listed here please add them, with the respective columns completed, and we will add them to OnePlace and seek approvals for them on your behalf." & vbNewLine & _
                "If you have any questions please contact gdprcompliance@dacbeachcroft.com" & vbNewLine & vbNewLine & _
                "Kind regards " & vbNewLine
                
                .Subject = mySubject
                .Body = strbody
                .to = Addressee
                .SentOnBehalfOfName = """GDPRcompliance"" <GDPRcompliance@dacbeachcroft.com>"
                .Attachments.Add myPath
                .Display
            End With
            Set otlNewMail = Nothing
'        End With
        End If
GoToNextSheet:
' GoTo should be avoided. Better to replace it with an IF condition.
    Next sh
    MsgBox "You can find the files in " & FolderName
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub