opslaan in nieuwe map, formules ongedaan maken

[wouter77]

Hallo,

ik heb gezocht op dit forum en heb her en der wel een deeloplossing voor mijn uitdaging gevonden, maar nog niet in zijn geheel werkend kunnen maken.Bekijk bijlage servicekosten voorbeeld.xlsm

In een bestand voer ik een complexnr (in cel B1 van werkblad "printen") in waarna er veel relevante gegevens uit andere bestanden worden opgehaald (komen samen in werkblad "totaal", formules zijn verwijderd). Deze gegevens komen vervolgens met simpele formules in afzonderlijke werkbladen ("Algemeen" "grboek 7 "grboek 8" en "kostenverdeel") en deze worden geprint. In werkelijkheid zijn het nog een 5 tal werkbladen meer, maar die moest ik verwijderen vanwege de grootte van het bestand.

De bedoeling is dat ik voor al onze complexen (+/- 300) de werkbladen ("Algemeen" "grboek 7 "grboek 8" en "kostenverdeel") zowel print als opsla.
Het printen van de afzonderlijke werkbladen lukt me met een eenvoudige VBA code, maar nu komt het:

Ik wil graag de werkbladen ("Algemeen" "grboek 7 "grboek 8" en "kostenverdeel") opslaan als een nieuw excelbestand op een netwerkschijf (bijvoorbeeld "K:\Domijn\Domijn Enschede\OSB\Wouter\test\), telkens onder een nieuwe map.
Naam van de map én het bestand is hetzelfde en staat in cel B1 van werkblad "printen" (en die veranderd dus telkens).

ik zou dan op de betreffende schijf +/- 300 mappen krijgen met in elke map het bijbehorende excelbestand:
"K:\Domijn\Domijn Enschede\OSB\Wouter\test\120001\120001.xlsx
"K:\Domijn\Domijn Enschede\OSB\Wouter\test\120002\120002.xlsx
"K:\Domijn\Domijn Enschede\OSB\Wouter\test\120003\120003.xlsx
enz

omdat in de werkbladen ("Algemeen" "grboek 7 "grboek 8" en "kostenverdeel") formules staan die verwijzen naar werkblad "totaal", moeten dan volgens mij al die formules verwijderd worden (kopieren + waarden plakken o.i.d.).

alvast bedankt!

 

[spaarie]

Iets in deze geest?

Sub Spaarie()
    naam = Sheets("Printen").Range("B1").Value
    Sheets(Array("Algemeen", "grboek7", "grboek8", "kostenverdeel")).Copy
    With ActiveWorkbook
        For Each s In .Sheets
            s.UsedRange.Value = s.UsedRange.Value
        Next
        .SaveAs "K:\Domijn\Domijn Enschede\OSB\Wouter\test\" & naam & ".xls"
        .Close
    End With
End Sub

 

[boomen]

Sub Opslaan()
ActiveWorkbook.SaveAs "Map waar je hem op will slaan copieren(regel bovenin documenten)" & Sheets("Blad1").Range("C3") & Sheets("Blad1").Range("C4").Value & ".xls"
End Sub

Bij deze pakt die Cel C3 en C4 om bij mij de bestandsnaam te creeeren en dat is bij het jaartal en een nummer.
Dus ik krijg dan bijvoorbeeld 2014EngelsRaai
Is dit wat je zoekt?

 

[wouter77]

Hallo Spaarie,

hartelijk dank! Ik krijg echter een foutmelding bij het uitvoeren van de code:
"Fout 9 tijdens uitvoering, subscript valt buiten het bereik" en dat geeft hij aan bij de coderegel: Sheets(Array("Algemeen", "grboek7", "grboek8", "kostenverdeel")).Copy

 

[spaarie]

Dan zal 1 van de opgegeven tabbladen (Algemeen, grboek7, grboek8 of kostenverdeel) niet bestaan of is niet juist geschreven iets in die geest... De code kan in elk geval het opgegeven tabblad niet vinden.

 

[wouter77]

ja klopt! was een spatie vergeten. Het werkt nu.
Alleen wordt er nu nog geen map aangemaakt met betreffende naam waar het excel bestand onder opgeslagen moet worden.

 

[spaarie]

Zoiets?

Sub Spaarie()
    n = Sheets("Printen").Range("B1").Value
    Sheets(Array("Algemeen", "grboek7", "grboek8", "kostenverdeel")).Copy
    With ActiveWorkbook
        For Each s In .Sheets
            s.UsedRange.Value = s.UsedRange.Value
        Next
        f = "K:\Domijn\Domijn Enschede\OSB\Wouter\test\"
        If Dir(f & n) = "" Then MkDir f & n
        .SaveAs f & n & "\" & n & ".xls"
        .Close
    End With
End Sub

 

[wouter77]

Geweldig!
Ontzettend bedankt! Dit scheelt me heel wat handwerk.