apart opslaan maar niet openen

[arierood]

Dag knappe koppen,
Met onderstaande code(gevonden in dit forum) laat ik een gedeelte van een ingevuld blad apart opslaan. Dat lukt op zich prima, alleen wil ik niet dat dit nieuwe bestand ook direct wordt geopend. Is dit mogelijk?
Bedankt voor jullie aandacht. Gr. Arie

Sub Opslaan()
Set NieuwBest = Workbooks.Add
ThisWorkbook.Worksheets(1).Range("A1:B1").Copy
NieuwBest.Worksheets(1).Range("B1").PasteSpecial Paste:=xlFormats
NieuwBest.Worksheets(1).Range("B1").PasteSpecial Paste:=xlValues
NieuwBest.SaveAs Filename:=ThisWorkbook.Worksheets(1).Range("A3")

End Sub

 

[Warme bakkertje]

Je kan geen data wegschrijven naar een gesloten bestand. Wat je kan doen is gebruik maken van ScreenUpdating om het kopieëren op de achtergrond te laten gebeuren en daarna het nieuwe bestand sluiten via dezelfde macro.

Mvg

Rudi

 

[arierood]

Dag Rudi,
Fijn dat je er even naar wilde kijken. Mijn probleem is dat ik een behoorlijke leek ben.
Kun je me met de codes wat op weg helpen? Gr. Arie

 

[Warme bakkertje]

Sub Opslaan()
Dim wb As Workbook
Application.ScreenUpdating = False
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("A1:B1").Copy
    NieuwBest.Worksheets(1).Range("B1").PasteSpecial Paste:=xlFormats
    NieuwBest.Worksheets(1).Range("B1").PasteSpecial Paste:=xlValues
    NieuwBest.SaveAs Filename:=ThisWorkbook.Worksheets(1).Range("A3")
For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name Then
        wb.Close
    End If
Next
Application.ScreenUpdating = True
End Sub

Mvg

Rudi

 

[arierood]

Ik krijg een 400-foutmelding. Er wordt een nieuw bestand aangemaakt (Map1) dat niet afsluit. Ik doe vast iets verkeerd.
Wil je bij gelegenheid er je licht nog eens over laten schijnen?
Bedankt. Gr. Arie

 

[arierood]

Een beetje zitten googelen en kwam op onderstaande code, die in ieder geval doet wat ik wil: een blad apart opslaan. Ik zou graag willen uitbreiden met het aangeven van het gedeelte dat gekopieerd moet worden, de range A1:B1. Ik heb het geprobeerd maar dat lukt me niet. Misschien dat iemand mij nog kan helpen?
Alvast bedankt. Gr. Arie

Sub SaveSingleSheet()
sheets("Sheet1").copy
activeworkbook.saveas filename:="Enter Path and Name Here"
activeworkbook.close
End Sub

 

[Warme bakkertje]

Arie, onderstaande werkt prima. Vul overal de juiste bladnaam en cel in en bij filename het juiste pad. De code doet dan de rest.

Sub Opslaan()
Dim wb As Workbook, NewName As String
Application.ScreenUpdating = False
NewName = Sheets("Blad1").Range("A3").Value
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Sheets("Blad1").Range("A1:B1").Copy
    NieuwBest.Sheets("Blad1").Range("B1").PasteSpecial Paste:=xlFormats
    NieuwBest.Sheets("Blad1").Range("B1").PasteSpecial Paste:=xlValues
    NieuwBest.SaveAs Filename:="D:\Mijn documenten\Helpmij\" & NewName
For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name Then
        wb.Close
    End If
Next
Application.ScreenUpdating = True
End Sub

Mvg

Rudi