macro problematiek

[hout80]

Hallo,

In een werkmap(A) met diverse bladen heb ik een macro welke 1 specifiek blad copieert naar een nieuwe map(B).
De macro sluit vervolgens de werkmap(A) af waar dit blad vandaan is gekomen zodat alleen nog de nieuwe map(B) met het gecopieerde blad actief is.
Nu is het de bedoeling dat mijn macro in blad(A) ook gelijk een bestandsnaam geeft aan blad(B)

Mijn macro ziet er alsvolgt uit:

Sheets("definitief").Select
Sheets("definitief").Copy
Application.DisplayAlerts = False
ThisWorkbook.Close
Application.DisplayAlerts = True
ThisWorkbook.SaveAs Filename:="C:\hugo\ah\accountant" & Range("A1")

De laatste regel (waarmee ik map(B) wil laten opslaan) wordt echter niet uitgevoerd.


Wie kan me verder helpen?

Hugo

 

[Jan van Asseldonk]

ThisWorkbook.SaveAs Filename:="C:\hugo\ah\accountant" & Range("A1")

aanvullen tot

ThisWorkbook.SaveAs Filename:="C:\hugo\ah\accountant" & Range("A1").Value

Het opgegeven pad moet wel bestaan en als je in A1 geen extensie achter de tekst hebt staan zie je het mogelijk niet terug als je het vanuit Excel op wilt vragen. Standaard worden dan alleen bestanden met extensie .xls getoond.

 

[hout80]

helaas

Helaas,

Het wil nog niet lukken.

Ik heb een testbestandje toegevoegd met daarin de macro

Bekijk bijlage testbestand.rar

Het opgegeven pad in de macro is een bestaand pad

Mijn probleem lijkt volgens mij veel op de onderstaande

http://www.helpmij.nl/forum/showthread.php?t=292014

Maar daar is men er ook nog niet uit.

Hugo

 

[Mr_Magoo]

Ik ben ooit eens bezig geweest met werkboeken kopiëren waar de formules uit verwijderd moesten worden en die dan vervangen moesten worden door waarden.
Hier zit alles in wat je nodig hebt, met enige aanpassingen ben je klaar

in je voorbeeld heb je in Cel A1 test.xls staan.
was het je bedoeling om de file de bladnaam mee te geven
gebruik dan ActiveSheet.Name en zet daar .xls achter inplaats dat neer te zetten in Cel A1

Sub CopieerWerkboekGeenFormules()
  'Maak variabelen die nodig zijn voor deze routine
  Dim OrigineleWerkboekNaam As String, NieuweWerkboekNaam As String, Werkblad As Object
  Dim AantalWerkbladen As Integer
  
  Application.ScreenUpdating = False
  OrigineleWerkboekNaam = ActiveWorkbook.Name 'pak de naam van het originele werkboek
  AantalWerkbladen = Application.SheetsInNewWorkbook 'Voor backup einde routine
  Application.SheetsInNewWorkbook = 1 'stel in op 1 werkblad  maken bij creeeren bij nieuw werkboek
  Workbooks.Add 'maak nieuw werkboek
  NieuweWerkboekNaam = ActiveWorkbook.Name 'pak de naam van het nieuwe werkboek
  
  'copieer werkbladen en formules verwijderen
  For Each Werkblad In Workbooks(OrigineleWerkboekNaam).Sheets
    Werkblad.Copy After:=Workbooks(NieuweWerkboekNaam).Sheets(Workbooks(NieuweWerkboekNaam).Sheets.Count)
    With Workbooks(NieuweWerkboekNaam).Sheets(Werkblad.Name)
      .Cells.Copy
      .Cells.PasteSpecial Paste:=xlPasteValues
      .Range("A1").Select
    End With
  Next
  
  'alles netjes opruimen
  With Application
    .CutCopyMode = False 'copieermode uit
    .DisplayAlerts = False 'melding weg omdat ik nu een werkblad ga verwijderen die als eerste is gemaakt
    .Workbooks(NieuweWerkboekNaam).Sheets(1).Delete 'verwijder werkblad
    .DisplayAlerts = True  'stel de melding weer in bij problemen
    .SheetsInNewWorkbook = AantalWerkbladen 'stel aantal werkbladen weer in zoals ze stonden bij aanvang
    .ScreenUpdating = True
  End With
  
  'sla copie zonder formules op en sluit deze
  Call FileDialogSave(CStr(Left(OrigineleWerkboekNaam, Len(OrigineleWerkboekNaam) - (Len(OrigineleWerkboekNaam) - InStrRev(OrigineleWerkboekNaam, "."))) & Replace(Now(), ":", ",")), NieuweWerkboekNaam)
  Application.ScreenUpdating = True
End Sub

Sub FileDialogSave(ByVal Filenaam As String, ByVal NieuweWerkboekNaam As String)
  ChDir Application.DefaultFilePath
  With Application.Filedialog(msoFileDialogSaveAs)
    .AllowMultiSelect = False
    .InitialFileName = Filenaam
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Filenaam = .SelectedItems(.SelectedItems.Count)
    Workbooks(NieuweWerkboekNaam).SaveAs Filename:=Filenaam, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Workbooks(Right(Filenaam, Len(Filenaam) - InStr(Filenaam, "\"))).Close SaveChanges:=False
  End With
End Sub

 

[hout80]

Eureka!

Mr. Magoo,

bedankt voor je tip, hierdoor ben ik op het idee gebracht om een macro te maken die
eerst het originele bestand opslaat
vervolgens alle "overtollige" werkbladen verwijderd en daarna het bestand onder een andere naam opslaat.

Simpel maar zeer doeltreffend.

Hugo