open twee sheets in nieuwe workbook

[Wezenspyk]

Beste allen,

bijgevoegd vinden jullie een voorbeeld bestand met 4 sheets. Ik wil een macro maken waarbij ik twee specifieke sheets open in een nieuwe workbook met de volgende voorwaarden:

de file mag nog niet automatisch opgeslagen worden, maar de save dialog box moet weergegeven worden zodat de gebruiker de juiste map kan plaatsen.
Bestand naam moet al wel ingevuld worden, namelijk de naam die staat in cel D2 (deze veranderd elke keer).

Sub fileSave()
'
Dim nameFile As String
Dim saveLoc As String
  
    nameFile = Worksheets("Overzicht").Range("D2").Value
    saveLoc = "N:\01_Directory_Finance_WIP\08_Accounts Payable\03_Creditcards_and_Declarations\03_Creditcards\2019" & nameFile

    
    Sheets(Array("Overzicht", "Cashwithdrawal ")).Copy ""
    ActiveWorkbook.SaveAs Filename:=saveLoc
    
End Sub

Kan iemand me hiermee helpen misschien? Bovenstaande code slaat het bestand al op in map: 03_creditcards met als naam "2019Naam - maand" op 1 of andere manier...

Thanks alvast!

 

[Wezenspyk]

Helaas heeft niemand me nog kunnen helpen. Uiteraard ben ik zelf verder gaan zoeken en heb besloten de taak op te splitsen. Misschien kan iemand me helpen met de volgende uitdaging die hier aan vast zit.

Ik probeer nu initieel om de huidige file op te slaan in een map met een specifieke naam via een safe dialog box. Het kopieren naar een andere (nieuwe) workbook komt later. Enigzins online te hebben gekeken, kwam ik uit bij de zogenoemde chDir om de default save-locatie t everanderen. Deze werkt helaas niet. Dit is de code zoals ik hem nu heb staan.

Dim NameFile As Variant
        
        With Worksheets("Overzicht")
            NameFile = .Range("D2") & ".xlsx"
        End With
        
        ChDir "N:\01_Directory_Finance_WIP\08_Accounts Payable\03_Creditcards_and_Declarations\03_Creditcards\2019"
        NameFile = Application.GetSaveAsFilename(InitialFileName:=NameFile, Filefilter:="Excel files (*.xlsx), *.xlsx")
        
        If NameFile = False Then
        MsgBox "File not saved"
        Else
        ThisWorkbook.SaveAs Filename:=NameFile
        End If
End Sub

Hoe zorg ik er voor dat de save dialog box wordt geopend op de locatie zoals staat achter chDir?

Vast bedankt!

 

[Wezenspyk]

Al weten op te lossen!!

Sub saveFile()
'
Dim NameFile As Variant
        
        With Worksheets("Overzicht")
            NameFile = .Range("D2") & ".xlsx"
        End With
        
        NameFile = Application.GetSaveAsFilename(InitialFileName:="N:\01_Directory_Finance_WIP\08_Accounts Payable\03_Creditcards_and_Declarations\03_Creditcards\2019\" & NameFile, Filefilter:="Excel files (*.xlsx), *.xlsx")
        
        If NameFile = False Then
        MsgBox "File not saved"
        Else
        ThisWorkbook.SaveAs Filename:=NameFile
        End If
End Sub

 

[Wezenspyk]

Oke, ik kom er verder niet goed uit en heb écht jullie hulp nodig. de code zoals ik hem nu heb staan is:

Sub saveFile()
'
Dim NameFile As Variant


ThisWorkbook.Sheets(Array("Overzicht", "Cashwithdrawal")).Copy

        With Worksheets("Overzicht")
            NameFile = .Range("D2") & ".xlsm"
        End With
        
        NameFile = Application.GetSaveAsFilename(InitialFileName:="N:\01_Directory_Finance_WIP\08_Accounts Payable\03_Creditcards_and_Declarations\03_Creditcards\2019\" & NameFile, Filefilter:="Excel files (*.xlsm), *.xlsm")
        If NameFile = False Then
            MsgBox "File not saved"
        Else
            ActiveWorkbook.SaveAs Filename:=NameFile
        End If

End Sub

De macro werkt goed, maakt een nieuwe workbook aan, kopieert de twee sheets hierin en vraagt vervolgens om op te slaan met de juiste naam en juiste locatie, maaaaar

Het opslaan doet deze code voor het 'moeder'-bestand. Ik wil graag dat de macro het nieuw gegenereerde bestand opslaat! Online lees ik dat als er een nieuwe workbook wordt gemaakt, dat deze active wordt. daar lijkt het nu niet op..
wat moet ik doen?

 

[BikerBill64]

Sub saveFile()
'
Dim NameFile As Variant


ThisWorkbook.Sheets(Array("Overzicht", "Cashwithdrawal")).Copy

        With Worksheets("Overzicht")
            NameFile = .Range("D2") & ".xlsm"
        End With
        [B]Workbooks(Worksheets("Overzicht").Range("D2").Value).Activate[/B]
        
        NameFile = Application.GetSaveAsFilename(InitialFileName:="N:\01_Directory_Finance_WIP\08_Accounts Payable\03_Creditcards_and_Declarations\03_Creditcards\2019\" & NameFile, Filefilter:="Excel files (*.xlsm), *.xlsm")
        If NameFile = False Then
            MsgBox "File not saved"
        Else
            ActiveWorkbook.SaveAs Filename:=NameFile
        End If

End Sub

 

[VenA]

Tenzij je nog andere code hebt lopen is het nieuwe bestand toch echt het ActiveWorkbook. Waarom opslaan als .xlsm als er toch geen code instaat?

Sub VenA()
  c00 = "E:\Temp\"
  c01 = Range("D2")
  Sheets(Array("Overzicht", "Cashwithdrawal")).Copy
  NameFile = Application.GetSaveAsFilename(c00 & c01, "Excel files (*.xlsm), *.xlsm")
  If NameFile = False Then MsgBox "File not saved" Else ActiveWorkbook.SaveAs NameFile, 52
End Sub

 

[Wezenspyk]

BEste Biker en Vena,

Dank voor jullie input.
@biker, ik heb jouw oplossing niet uitvoerig getest, gezien deze niet werkte(zoals ik dat wilde).
@Vena een zeer goede oplossing! Dank. Hij werkt perfect