Gem ark i anden workbook med navn fra celle uden formler

Hej Klaus

Tror følgende vil fungere

Dim Name As String

Set WS = Sheets("Bestilling")
Set NameCell = WS.Range("G2")
Name = NameCell.Value

WS.Copy
WB = Workbook.Add
WB.Name = Name
NewSheet = WB.Sheets(1)

NewSheet.Name = WS.Name
NewSheet.PasteSpecial Paste:=xlPasteValues

WB.SaveAs Name

End Sub

Hej Jan
Jeg kan ikke få den til at køre eller den køre og køre og laver efter lang tid en kopi med navne Mappe.
Der kommer også en fejl meddelse i VBA-koden
WB = Workbook.Add
Jeg lægger den op i onedrive hvis du vil hjælpe videre.
Hilsen Klaus

https://1drv.ms/x/s!AmLaaGiC5LdoicgQ7ulIWqkfdD185g?e=yjjIZb

Hej igen

mon dette ikke kan bruges:

[Sub MM1()
Application.ScreenUpdating = False
'----------/Døber variable/--------------'
Dim CopyWb As Workbook, PasteWB As Workbook
Dim CopyWS As Worksheet, PasteWS As Worksheet
Dim NameCell As Range
Dim Name As String
'----------/Tildeler variable indhold/--------------'
Set CopyWb = ThisWorkbook
Set CopyWS = CopyWb.Sheets("Bestilling")
Set NameCell = CopyWS.Range("G2")
Set PasteWB = Workbooks.Add
Set PasteWS = PasteWB.Sheets(1)
Name = NameCell.Value
'----------/Navngiver ark 1/--------------'
PasteWS.Name = CopyWS.Name
'----------/Tager en kopi af cellerne i "bestilling"/--------------'
CopyWS.Cells.Copy
'----------/formaterer og overfører data til det nye ark/--------------'
PasteWS.Cells.PasteSpecial xlPasteValues
PasteWS.Cells.PasteSpecial xlPasteFormats
PasteWS.Rows("9").Select
ActiveWindow.FreezePanes = True
PasteWS.Range("A1").Select
Application.CutCopyMode = False
'----------//--------------'
Application.ScreenUpdating = True

Application.Dialogs(xlDialogSaveAs).Show Name, 51
   
Msgbox_BeforeRunning

End Sub

]
Mvh Jan

Sub MM1()
Application.ScreenUpdating = False
'----------/Døber variable/--------------'
Dim CopyWb As Workbook, PasteWB As Workbook
Dim CopyWS As Worksheet, PasteWS As Worksheet
Dim NameCell As Range
Dim Name As String
'----------/Tildeler variable indhold/--------------'
Set CopyWb = ThisWorkbook
Set CopyWS = CopyWb.Sheets("Bestilling")
Set NameCell = CopyWS.Range("G2")
Set PasteWB = Workbooks.Add
Set PasteWS = PasteWB.Sheets(1)
Name = NameCell.Value
'----------/Navngiver ark 1/--------------'
PasteWS.Name = CopyWS.Name
'----------/Tager en kopi af cellerne i "bestilling"/--------------'
CopyWS.Cells.Copy
'----------/formaterer og overfører data til det nye ark/--------------'
PasteWS.Cells.PasteSpecial xlPasteValues
PasteWS.Cells.PasteSpecial xlPasteFormats
PasteWS.Rows("9").Select
ActiveWindow.FreezePanes = True
PasteWS.Range("A1").Select
Application.CutCopyMode = False
'----------//--------------'
Application.ScreenUpdating = True

Application.Dialogs(xlDialogSaveAs).Show Name, 51
   
Msgbox_BeforeRunning

End Sub

Hej Jan 1000 tak lige i skabet.

KW