bepaalde tab bladen versturen in VBA

Sub Mail_Sheets_Array()

    
Call Uitsorteren
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    
    With Sourcewb
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        .Sheets(Array("rooster", "Export TT")).Copy
    End With

    
    TempWindow.Close

    Set Destwb = ActiveWorkbook

    
    With Destwb
        If Val(Application.Version) < 12 Then
            
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            '
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .to = "norman.persijn@hoogesteger.nl"
            .CC = ""
            .BCC = ""
            .Subject = "Rooster"
            .Body = "Hoi"
            .Attachments.Add Destwb.FullName
            '
            .Send
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With

    
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Sub VenA()
  Application.DisplayAlerts = False
  c00 = Environ$("temp") & "\Part of " & ActiveWorkbook.Name & Format(Now, " dd-mmm-yy h-mm-ss") & ".xlsx"
  Sheets(Array("rooster", "Export TT")).Copy
  ActiveWorkbook.SaveAs c00, 51
  ActiveWorkbook.Close 0
  
  With CreateObject("Outlook.Application").CreateItem(0)
    .to = "np@mail.nl"
    .Subject = "Rooster"
    .Body = "Hoi"
    .Attachments.Add c00
    .display '.Send
  End With
  Kill c00
End Sub

Sub VenA()
    .to = Range("A1")
    .Subject = Range("A2")
    .Body = Range("A3")
End Sub

Sub VenA()
  ar = Sheets("mail").Cells(1).CurrentRegion
  Application.DisplayAlerts = False
  c00 = Environ$("temp") & "\Part of " & ActiveWorkbook.Name & Format(Now, " dd-mmm-yy h-mm-ss") & ".xlsx"
  Sheets(Array("rooster", "Export TT")).Copy
  ActiveWorkbook.SaveAs c00, 51
  ActiveWorkbook.Close 0
  
  For j = 1 To UBound(ar)
    Select Case LCase(ar(j, 1))
      Case "aan": c01 = c01 & "," & ar(j, 2)
      Case "cc": c02 = c02 & "," & ar(j, 2)
    End Select
    If ar(j, 3) <> "" Then c03 = c03 & ar(j, 3) & vbCrLf
  Next j
  
  With CreateObject("Outlook.Application").CreateItem(0)
    .to = Mid(c01, 2)
    .cc = Mid(c02, 2)
    .Subject = "Rooster"
    .Body = c03
    .Attachments.Add c00
    .display '.Send
  End With
  Kill c00
End Sub

Sub Validatie_terug()
'
' Validatie_terug Macro
'

'
    ActiveCell.SpecialCells(xlCellTypeSameValidation).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=VERSCHUIVING($BR$1;0;0;AANTALARG($BR$1:$BR$300)+1;1)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("C9:D9").Select
End Sub

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=VERSCHUIVING($BR$1;0;0;AANTALARG($BR$1:$BR$300)+1;1)"

Sub M_snb()
    Cells(1).Validation.Add 3, , , "=" & Columns(6).SpecialCells(2).Address(, , , -1)
    Cells(1).Validation.Modify , , , "=" & Columns(8).SpecialCells(2).Address(, , , -1)
End Sub