VBA kode der skal forkortes

Er der nogen der kan give en hånd med at forkorte nedenstående kode, så den ikke er så stor ud.

Sub S_V_Outlook_MANDAG()
Dim VHT1 As String
Dim VHT2 As String
Dim VHT3 As String
Dim VHT4 As String
Dim VHT5 As String
Dim VHT6 As String
Dim VHT7 As String
Dim VHT8 As String
Dim VHT9 As String
Dim EM1 As String
Dim EM2 As String
Dim EM3 As String
Dim EM4 As String
Dim EM5 As String
Dim EM6 As String
Dim EM7 As String
Dim EM8 As String
Dim EM9 As String
Dim PF1 As String
Dim PF2 As String
Dim PF3 As String
Dim PF4 As String
Dim PF5 As String
Dim PF6 As String
Dim PF7 As String
Dim PF8 As String
Dim PF9 As String

Dim sh As Worksheet
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem

On Error Resume Next

Set sh = Worksheets("Email")
For Each C In Selection
Set olApp = New Outlook.Application
Set olNewMail = CreateItem(olMailItem)

VHT1 = sh.Range("MANF1").Value
VHT2 = sh.Range("MANF2").Value
VHT3 = sh.Range("MANF3").Value
VHT4 = sh.Range("MANF4").Value
VHT5 = sh.Range("MANF5").Value
VHT6 = sh.Range("MANF6").Value
VHT7 = sh.Range("MANF7").Value
VHT8 = sh.Range("MANF8").Value
VHT9 = sh.Range("MANF9").Value
EM1 = sh.Range("MANE1").Value
EM2 = sh.Range("MANE2").Value
EM3 = sh.Range("MANE3").Value
EM4 = sh.Range("MANE4").Value
EM5 = sh.Range("MANE5").Value
EM6 = sh.Range("MANE6").Value
EM7 = sh.Range("MANE7").Value
EM8 = sh.Range("MANE8").Value
EM9 = sh.Range("MANE9").Value
PF1 = sh.Range("MPF1").Value
PF2 = sh.Range("MPF2").Value
PF3 = sh.Range("MPF3").Value
PF4 = sh.Range("MPF4").Value
PF5 = sh.Range("MPF5").Value
PF6 = sh.Range("MPF6").Value
PF7 = sh.Range("MPF7").Value
PF8 = sh.Range("MPF8").Value
PF9 = sh.Range("MPF9").Value


With olNewMail
    .Recipients.Add EM1 & ";" & EM2 & ";" & EM3 & ";" & EM4 & ";" & EM5 & ";" & EM6 & ";" & EM7 & ";" & EM8 & ";" & EM9
    '.CC = ""
    '.BCC = ""
    .Subject = "Oplagsfiler"
'    .Body = ""
    .Attachments.Add VHT1
    .Attachments.Add VHT2
    .Attachments.Add VHT3
    .Attachments.Add VHT4
    .Attachments.Add VHT5
    .Attachments.Add VHT6
    .Attachments.Add VHT7
    .Attachments.Add VHT8
    .Attachments.Add VHT9
    .Save
    .Display
'    .send
End With

Set olNewMail = Nothing
Set olApp = Nothing
Next C
End Sub