tabbladen afzonderlijk opslaan in nieuwe gecreëerde map

[starchaser]

Dag beste mensen,

Ik heb een bestandje waarbij er drie tabbladen afzonderlijk moeten opgeslagen worden in .xls én .csv formaat. (Artikel, Artlev, Artvp)
De files moeten in een nieuwe map komen die de naam krijgt van tabblad "Data" Cel F2

In bijlage vinden jullie een testbestandje (alle namen zijn fictief), waar ik met het nodige geknutsel en opzoekwerk al wat in vba heb gemaakt.

De 3 tabbladen worden hiermee in beide formaten opgeslagen, maar de nieuwe aangemaakte map krijgt niet de naam van cel F2.
Tevens moeten de nieuwe files automatisch afgesloten worden, maar nu blijven ze openstaan en wordt er gevraagd voor op te slagen.

Kunnen jullie dit eens bekijken en mij informeren waar ik de mist in ga?

alvast bedankt

 

[VenA]

MkDir "C:\Users\Danny\Documents\Bestanden\FName\\"

En als je de laatste \ weglaat?

 

[starchaser]

[/CODE]En als je de laatste \ weglaat?

Nee,... geen verschil...

 

[Ginger]

Volgens mij moet je géén van die laatste 2 backslashes plaatsen bij de MkDir opdracht. Daarnaast moet wel ELK onderdeel van het gebruikte pad beschikbaar zijn. Anders gaat het nooit werken.

 

[VenA]

Door het hele breiwerk aan code niet goed opgelet. Met een simpele routine

Sub VenA()
  c00 = "E:\temp\"
  FName = ThisWorkbook.Sheets("Data").Range("f2").Value
  If Dir(c00 & FName, 16) = "" Then MkDir c00 & FName
End Sub

 

[starchaser]

Door het hele breiwerk aan code niet goed opgelet. Met een simpele routine

Sub VenA()
  c00 = "E:\temp\"
  FName = ThisWorkbook.Sheets("Data").Range("f2").Value
  If Dir(c00 & FName, 16) = "" Then MkDir c00 & FName
End Sub

Bedankt VenA Map wordt nu aangemaakt met de juiste naam.
Blijft nog enkel het probleem over dat de nieuwe files ook direct moeten afgesloten worden. Nu wordt er nog gevraagd of de bestanden moeten opgeslagen worden en moet men dus eerst bevestigen.

 

[cow18]

voor je SaveAs gebruik je

Application.DisplayAlerts = False

daarna zet je die terug aan

 

[VenA]

Het quoten is niet nodig. Je kan proberen er iets van VBA van te maken dan krijg je ook geen meldingen. Bv.

Sub VenA()
  Application.ScreenUpdating = False
  c00 = "E:\temp\"
  c01 = Sheets("Data").Range("F2").Value
  If Dir(c00 & c01, 16) = "" Then MkDir c00 & c01
  For Each sh In Sheets
    If sh.Name <> "Data" Then
      sh.Copy
      With ActiveWorkbook
        .Sheets(1).UsedRange = .Sheets(1).UsedRange.Value
        .SaveAs c00 & c01 & "\" & sh.Name & c01 & Format(Now, "yyyymmdd hhmmss") & ".xlsx", 51
        .SaveAs c00 & c01 & "\" & sh.Name & c01 & Format(Now, "yyyymmdd hhmmss") & ".csv", 6
        .Close 0
      End With
    End If
  Next sh
End Sub

 

[snb]

Met dank aan de voorganger(s):

Sub M_snb()
  Application.ScreenUpdating = False
  sn = Array("E:\temp\" & Sheets("Data").Range("F2").Value, Sheets("Data").Range("F2").Value & Format(Now, "yyyymmdd hhmmss"))
  
  If Dir(sn(0), 16) = "" Then MkDir sn(0)
  For Each sh In Sheets
    If sh.Name <> "Data" Then
      sh.Copy
      With ActiveWorkbook
        .Sheets(1).UsedRange = .Sheets(1).UsedRange.Value
        .SaveAs sn(0) & "\" & sh.Name & sn(1) & ".xlsx", 51
        .SaveAs sn(0) & "\" & sh.Name & sn(1) & ".csv", 6
        .Close 0
      End With
    End If
  Next
End Sub

 

[starchaser]

Iedereen bedankt voor de hulp.
Werkt zoals het moet...
grtn