VBA kode der gemmer Aktivt Sheet i ny Excel fil

Public Sub Gem_side()

Dim filnavn As String
Dim mappe As String

mappe = "c:\" ' ændres til ønsket placering på drev
filnavn = InputBox("Navn på filen", "Skal arket gemmes")

Sheets("Ark1").Copy 'ændres til dit ark navn

ActiveWorkbook.SaveAs Filename:=mappe & filnavn

End Sub

Ok - vha koden får jeg taget en kopi af Ark1 og kan herefter gemme dette.
Dog er problemet at jeg på Ark1 har tre CommandButtons med makroer
der forbinder Ark1 med nogle andre Ark vha tabelopslag.Disse andre Ark bliver ikke kopieret med over i den nye WorkBook og skal heller ikke.

Kunne det tænkes at jeg i stedet laver et navngivent område og alene lader de talværdier i området komme over i det nye Ark der gemmes?

En anden ting er at der er flere brugere af denne Excel fil og ikke alle vil have kopi af Ark1 gemt samme sted som koden gør.

Kan man lave en funktion hvor man får samme dialog boks som når man vælger Gem Som på på værktøjslinien - altså får mulighed for at angive sti og filnavn  ?

Sub ArkCopy()
Application.SheetsInNewWorkbook = 1
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.SheetsInNewWorkbook = 3
Range("A1").Select
Application.Dialogs(xlDialogSaveAs).Show
End Sub

excelent så er jeg næsten i mål.
Et sidste ønske vil fulende.
I Cellen F3 på arket "Result" har jeg en textbox hvor brugeren kan skrive nogle
kommentare til de udregnede værdier. Denne textbox må meget gerne komme med over i det nye Ark.

På samme måde har jeg også et billede "Picture2" indsat i Arket "Result"  - det vil være super hvis også dette kunne indsættes i det nye Ark i celle C30.

Kan det lade sig gøre ?

Billeder og tekstbokse kopieres også med
hvis der er flere som ikke skal med, kan de slettes
hvis de ikke placeres rette sted, kan de flyttes
?

Nej desværre kommer min textbox "Comments" ikke med og heller ikke "Picture2".
Jeg kan se at det er muligt at justere den fysiske placering af sådanne objekter på et Sheet via objekternes Properties, men sagen er at de ikke kommer med. Jeg tænkte om det vil være muligt at indsætte en linie hvor de to objecter Selectes - Kopieres - Indsættes i det nye Ark, har forsøgt men uden held og har derfor slettet koderne igen da der kom fejl.

Du får lige hele koden her, den kører OK i denne form - jeg måtte hustle mig igennem vha makrooptager for at hitte nogle af koderne. Bemærk: Jeg har navngivet området der skal kopieres til "ResultRange"

Sub SaveSheetAs_Click()
Application.SheetsInNewWorkbook = 1
Worksheets("Result").Range("ResultRange").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
Range("D2").Select
'Indsæt kun nummerværdier og uden formler
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Indsæt samme celleformat
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.SheetsInNewWorkbook = 3
Application.Dialogs(xlDialogSaveAs).Show
' tilpas kolonner og cellebredde så de svare til kildearkets
    Rows("23:23").EntireRow.AutoFit
    Rows("24:24").EntireRow.AutoFit
    Rows("24:24").EntireRow.AutoFit
    Rows("24:24").RowHeight = 52.5
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Rows("24:24").RowHeight = 29.25
    Columns("D:D").ColumnWidth = 38.14
    Columns("E:E").ColumnWidth = 20.86
    Columns("G:G").ColumnWidth = 23.14
    Columns("F:F").ColumnWidth = 19.86
    Range("D2:G2").Select
    ActiveCell.FormulaR1C1 = _
        "Result Sheet Calculation of Non Standard Material  Ver. 1.0"
    With ActiveCell.Characters(Start:=1, Length:=51).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=52, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
         
End Sub

excelent - foreløbig tak for hjælpen, jeg forsøger mig frem herefter.
Smid et svar og der er point til dig

Min kode udvidet til at kopiere et billede

Sub ArkCopy()
Application.SheetsInNewWorkbook = 1
Range("A1:H40").Select
Selection.Copy
Workbooks.Add
navn = ActiveWorkbook.Name
ActiveSheet.Paste
Application.SheetsInNewWorkbook = 3
Range("A1").Select

ThisWorkbook.Activate
Sheets("Ark1").Shapes("Picture 4").Select ' ret til aktuel billede navn
Selection.Copy
Workbooks(navn).Activate
Range("G15").Select
ActiveSheet.Paste
Application.Dialogs(xlDialogSaveAs).Show

End Sub