Workbook close functie

[Johnster]

In onderstaande code kopieer ik mijn worksheet en sla ik deze op in een map afhankelijk van de datum.
Mijn workbook sluit af maar nu blijft de gekopieerde file geopend. Welke code zet ik hierbij om deze ook te sluiten?

Private Sub CommandButton1_Click()
On Error GoTo GetOut

Dim ws As String, folder As String
Dim Datum1 As String, Datum As String
Dim maand As Integer, Datum2 As String
Dim file As String
Dim wse As Worksheet

ActiveSheet.Protect "", False

ws = Range("A2")
Datum = Range("B6")

folder = ActiveWorkbook.Path & "\Afgenomen audits"
Datum1 = Format(Datum, "mmmm")
Datum2 = Format(Datum, "dd-mm-yyyy")
file = ActiveWorkbook.Path & "\Afgenomen audits" & "" & Datum1

If Dir(file, vbDirectory) = vbNullString Then
MkDir (file)
End If

    If WorksheetFunction.CountA(Range("B6")) = 0 Then
        MsgBox "Gelieve een datum in te vulllen"
        Exit Sub
    End If

    If WorksheetFunction.CountA(Range("D9")) = 0 Then
        MsgBox "Gelieve een naam in te vulllen"
        Exit Sub
    End If
    
With Application
        .ScreenUpdating = False

        On Error GoTo GetOut
        Sheets(Array("3rd level")).Copy
        On Error GoTo 0

        For Each wse In ActiveWorkbook.Worksheets
            wse.Cells.Copy
            wse.[A1].PasteSpecial Paste:=xlValues
            wse.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            wse.Activate
        Next wse
        
ActiveWorkbook.SaveCopyAs Filename:=folder & "" & Datum1 & "" & ws & " " & Datum2 & " " & Cells(9, 4) & ".xls"
MsgBox "Document met succes opgeslagen"
ActiveWorkbook.Close SaveChanges:=False
End With
Application.ScreenUpdating = True
GetOut:
MsgBox Err.Description
End Sub

 

[edmoor]

Je wilt het werkboek waarin die VBA code draait sluiten?

ThisWorkbook.Close

 

[Johnster]

Nee dat werkt maar hij opent het nieuwe bestand en dat wil ik terug laten afsluiten

 

[VenA]

Probeer wat logica in de code aan te brengen. Eerst controleren of alle verplichte cellen ingevuld zijn en dan pas een map aanmaken? CountA voor een enkele cel? For Each wse als er maar 1 blad aangepast hoeft te worden?
Ik denk dat je zoiets bedoelt en anders maar een voorbeeldbestand plaatsen.

Sub VenA()
  Application.ScreenUpdating = False
  ar = Array("B6", "D9", "Gelieve een datum in te vulllen", "Gelieve een naam in te vulllen")
  For j = 0 To 1
    If Range(ar(j)) = "" Then
      MsgBox ar(j + 2)
      Application.Goto Range(ar(j))
      Exit Sub
    End If
  Next j
  c00 = ActiveWorkbook.Path & "\Afgenomen audits" & Format(Range("B6"), "mmmm") & "\"
  If Dir(c00, vbDirectory) = vbNullString Then MkDir c00
  Sheets("3rd level").Copy
  With ActiveWorkbook.Sheets(1)
    .UsedRange = .UsedRange.Value
    .UsedRange.Hyperlinks.Delete
    .Parent.SaveAs c00 & .Range("A2") & " " & Format(.Range("B6"), "dd-mm-yyyy") & " " & .Range("D9") & ".xlsx", 51
    .Parent.Close False
  End With
End Sub