opslaan van 1 blad in een Excel bestand

[Shery]

Krijg het nog niet voor elkaar hoor

Nu ben ik nog steeds de opmaak kwijt en krijg een melding dat :

Fout 1004 tijdens uitvoering
Kan geen toegang krijgen tot het bestand C:\ documents and settings .......enz enz
Er zijn verschillende mogelijke oorzaken:
De naam van het pad of bestand bestaat niet
Het bestand wat u probeert te openen wordt gebruikt door een anderprogramma.sluit het bestand in het andere programma en probeer het opnieuw

Ik heb echt geen idee meer wat ik hieraan kan doen

 

[jpvs]

waarin de gebruiker dan kan aangeven waar hij dit blad wil opslaan
en het zou helemaal mooi zijn als er al een dir wordt aangegeven welke bestaat uit variabele tekst welke staat in blad1 cel c2 en d6

Heb verder gedaan met de macro van Wigi.

Verbeterd : Opmaak en opslaan via 2 cellen?

Met nog wel een paar schoonheidsfoutjes

Private Sub CommandButton7_Click()
Dim NewBook As Workbook, ws As Worksheet

Set NewBook = Workbooks.Add

For Each ws In NewBook.Worksheets
If ws.Index > 1 Then ws.Delete
Next

Workbooks("calculatie27.xls").Sheets("Blad1").Cells.Copy
With NewBook.Sheets(1).Range("A1")
.PasteSpecial xlPasteAll 'Values
.Select
End With
ActiveSheet.SaveAs Filename:=Sheets("Blad1").Range("C2") & "_" & Sheets("Blad1").Range("D6")
Application.CutCopyMode = False


Do
FName = Application.GetSaveAsFilename
Loop Until FName <> False
If Right(FName, 3) = "xls" Then
NewBook.SaveAs Filename:=FName
Else
NewBook.SaveAs Filename:=FName & "xls"
End If


ActiveWorkbook.Close

End Sub

Moet weg nu.

Pierre

 

[Shery]

Pierre bedankt :thumb:
dit is wat ik nodig had kon er zelf niet uitkomen maar dankzij jou hulp heb ik er het volgende van gemaakt
Private Sub CommandButton7_Click()
Dim NewBook As Workbook, ws As Worksheet

Set NewBook = Workbooks.Add

For Each ws In NewBook.Worksheets
If ws.Index > 1 Then ws.Delete
Next

Workbooks("calculatie27.xls").Sheets("Blad1").Cells.Copy
With NewBook.Sheets(1).Range("A1")
.PasteSpecial xlPasteAll 'Values
.Select
End With
' ActiveSheet.SaveAs Filename:=Sheets("Blad1").Range("C2") & "_" & Sheets("Blad1").Range("D6")
' Application.CutCopyMode = False


Do
FName = Application.GetSaveAsFilename(InitialFileName:=Sheets("Blad1").Range("D2") & "_" & Sheets("Blad1").Range("C6"))
Loop Until FName <> False
If Right(FName, 3) = "xls" Then
NewBook.SaveAs Filename:=FName
Else
NewBook.SaveAs Filename:=FName & "xls"
End If


ActiveWorkbook.Close

End Sub

en weet je wat Het werkt