Automatisk oprettelse af en fil, eller tilføje ark hvis fil eksistere

Hej alle

Jeg har fået flot hjælp fra perhol tidligere i et lign. spørgsmål. Mit problem nu går ikke på at oprette en mappe, men en fil. 1. gang jeg kører nedenstående makro fungere alt som det skal. Problemet er hvordan jeg tillader at en eksisterende fil bliver åbnet og ikke overskrevet, og et nyt ark bliver tilføjet filen.
Jeg skal bruge den nye fil til en sammentælling af alle de ark der indgår.

Makroen:

Onr = Sheets("MH").Range("H2").Value
Dnr = Sheets("MH").Range("F2").Value

'
    Range("E64:G82").Select
    Selection.Copy
    Workbooks.Add
    Sheets("Ark1").Select
    Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:C").Select
    Columns("A:C").EntireColumn.AutoFit
    Range("B3,B5").Select
    Range("B5").Activate
    Application.CutCopyMode = False
    Selection.NumberFormat = "[h]:mm:ss"
    Columns("C:C").Select
    Selection.Style = "Comma"
    ActiveSheet.Name = Dnr

ActiveWorkbook.SaveAs CheckMakePath("P:\Kalkulation_døre\" & "Sammentælling_" & Onr) & Onr & ".xls"

Der er en funktion der hedder CheckMakePath

Function CheckMakePath(ByVal vPath As String) As String
    Dim PathSep As Long, oPS As Long
    If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
    PathSep = InStr(3, vPath, "\")
    If PathSep = 0 Then Exit Function
    Do
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
        If PathSep = 0 Then Exit Do
        If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until PathSep = 0
        MkDir Left(vPath, PathSep)
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
    Loop
    CheckMakePath = vPath
End Function


Håber som altid på hjælp
PFT
Ups