Copy Worksheet og Save As

Hej

Jeg har tyvstjålet macro-delen som udfører Save As funktionen, men jeg får kun gemt mit ActiveSheet og ikke hele workbook'en.

Jeg har prøvet frem og tilbage med at omdøbe diverse ActiveSheet til ActiveWorkbook osv., men kan ikke få det til at virke som ønsket.

Hele Sub'en ser således ud:
Sub Save_As()


'Working in Excel 2000-2010
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long
  Dim myrange As Range
Set myrange = Sheets("Ark1").Range("C7,C9,C11,C12,C14,E7,E8")
If Application.WorksheetFunction.CountA(myrange) < 7 Then
MsgBox "Udfyld Modtager/Afsender info før du gemmer"
Exit Sub
End If

    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If

   
   
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
       
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
        " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel 2000-2003 Workbook (*.xls), *.xls," & _
        " Excel Binary Workbook (*.xlsb), *.xlsb", _
        FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                            FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

            .DeleteLines 1, .CountOfLines

    End With
 


End Sub

Nogen tanker på anderledes måder at udføre SaveAs med en kopi af workbook'en?