werkblad kopieëren

[Cruimel]

Hallo experts,

Na veel zoeken op dit forum kom ik niet uit een volgend probleem. Ik heb een invoerbestand opgezet met allerhande invoercellen en verwijzingen. De bedoeling is als dit blad klaar is dit via een macro te kopieëren naar een nieuw bestand. Zonder dat het originele bestand onbruikbaar wordt (dat is tot nu toe steeds het geval ). Het blad moet gekopieerd en opgeslagen worden met een naam en pad die vooraf gedefinieerd is in een paar cellen bovenin het invoerbestand.
Met alle macro's die ik heb gevonden op dit forum, kom ik helaas niet tot het gewenste resultaat.. Weten jullie een oplossing??

superbedankt,
Cruimel

 

[Ron321]

Heb je het al geprobeerd met de macro recorder?

 

[trucker10]

ook bij deze topic gekeken ? http://www.helpmij.nl/forum/showthread.php?t=416663

 

[Cruimel]

Helaas, doet niet wat ik zou willen.. Erbij vermelden, ik ben een beginneling met macro's en vba.. Ik voeg mijn bestand bij..

 

[Warme bakkertje]

Bij deze

Mvg

Rudi

 

[Cruimel]

Hoi Rudi,

Bedankt voor je hulp, alleen krijg ik gelijk al een foutmelding:

'wijzigt de directory
ChDir pad

Is dat iets wat nog aangepast moet worden omdat de macro op mijn bestand wordt toegepast? Hopelijk is daar een fix voor, want ik ben erg benieuwd hoe dit gaat werken..

Cruimel

 

[Warme bakkertje]

Het pad in je werkblad mag niet tussen aanhalingstekens staan(zie voorbeeldbestand)

Mvg

Rudi

 

[Cruimel]

Rudi,

Helemaal top, werkt heel goed. Ik ben zo vrij geweest de macro met sneltoets te starten inplaats van met een button.. Is het verder gepermiteerd om in deze vraag een uitbreiding in te lassen? Uiteindelijk zal het bestand moeten bewerkstelligen dat er een factuur uitkomt rollen. Ik heb het bestand hiermee nu uitgebreid. Kan dezelfde macro het aan om niet 1 blad maar twee bladen te kopieeren naar een bestand? Ik heb al wat opties geprobeerd, maar kan in de programmataal niet echt ontdekken waar aangegeven wordt om welk werkblad het gaat. In dit verzoek dus om twee werkbladen: invoerschermen en factuur. Voor de duidelijkheid het bestand bijgevoegd..

Cruimel

 

[Warme bakkertje]

Sub Bladen_opslaan()
Dim pad As String, filenaam As String
Application.ScreenUpdating = False
pad = [M1].Value
filenaam = Replace(Replace(Replace([K1].Value, ":", "-"), ".", ""), " ", "") & ".xls"
ChDir pad
Sheets(Array("invoerschermartikelen", "factuur")).Copy
Application.DisplayAlerts = False
Call BreakLinks
With ActiveWorkbook
    .SaveAs Filename:=filenaam
    .Saved = True
    .Close
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
MsgBox "File is opgeslagen"
End Sub
Sub BreakLinks()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        With ws.UsedRange
            .Copy
            .PasteSpecial xlValues
        End With
        Application.CutCopyMode = False
        [A1].Select
    Next ws
End Sub

Mvg

Rudi

 

[Cruimel]

Rudi,

Allereerst bedankt hoor.. Heel mooi werk, 1 detail nog. Het bestand wordt niet op de voorgedefinieerde plaats (cel M1) opgeslagen. Maar ergens in "mijn documenten".
Is dat nog lastig aan te passen?

Cruimel

 

[Warme bakkertje]

Vanop welk blad heb je de macro gestart ?
Wijzig anders naar

pad=[invoerschermartikelen!M1].Value

Mvg

Rudi

 

[Cruimel]

Rudi,

Helaas,
Werkt niet. Macro opstarten vanaf werkblad facturen, geen in eerste instantie een foutmelding. Als daarna filenaam= [] ook een verwijzing maar naar het blad invoerschermartikelen, komt er geen foutmelding meer.. Echter het bestand komt toch nog terecht in de map "mijn documenten" en niet op de gewenste plek.Ik heb gisteravond nog geexperimenteerd met andere tips op het forum,

ChDir "C:\vracht"
ActiveSheet.SaveAs Filename:="C:\vracht\" & [c58].Value & [c57].Value & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True _
, CreateBackup:=False
ActiveWorkbook.Close
Sub fff()
ActiveSheet.Copy
With ActiveWorkbook

En met:
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
.SaveAs Filename:="C:\vracht\" & Range("C58").Value & Range("C57").Value, ReadOnlyRecommended:=True
.Close 0
End With
End Sub


Helaas niet het gewenste resultaat kunnen pakken..

Heb je misschien toch nog een tip, of zal ik de macro in tweeen moeten gaan delen..

Cruimel

 

[Warme bakkertje]

Je hoeft niks te delen. Je moet enkel in de juiste cellen de juiste informatie zetten en de macro overeenkomstig aanpassen

pad=[bladnaam!cel].Value
filenaam=[bladnaam!cel].Value

Voor de rest werken beide macros perfect. Ik kan hier het bestand plaatsen met de informatie op eender welk blad. Voor de rest kan ik er niet veel aan toe voegen want ik zie echt het probleem niet. Plaats anders eens een bestandje met alles op de juiste plaats en welke bereiken of bladen je wil kopieëren

Mvg

Rudi

 

[Cruimel]

Rudi,

Zo heb ik het ook begrepen en toegepast, zie bestand.
Sorry voor de hardnekkigheid, ik snap hem ook niet, het moet werken te zien aan de code.


Cruimel

 

[Warme bakkertje]

Bestaat de doeldirectory reeds ? Wat ik ook probeer, het werkt altijd.

Mvg

Rudi

 

[snb]

Vermijd select en activate in VBA.
O.a. Chdir is overbodig

Sub Bladen_opslaan()
  Sheets(array("invoerschermartikelen", "factuur")).Copy
  With ActiveWorkbook.sheets("invoerschermartikelen")
    Actvieworkbook.SaveAs "C:\vracht\" & [B][COLOR="Red"].[/COLOR][/B][c58] & [B][COLOR="red"].[/COLOR][/B][c57] & ".xls
  End With
  ActiveWorkbook.Close
End Sub

 

[Cruimel]

Beste helpers,

Helaas ook deze code is niet helemaal, klein typefoutje in code ontdekt.. Maar na dit te hebben aangepast, nog steeds een foutmelding op het pad.. De directory bestaat wel.. Varianten met en zonder spaties in de map naam geprobeerd. foutmelding blijft.

Sub Bladen_opslaan()
Sheets(Array("invoerschermartikelen", "factuur")).Copy
With ActiveWorkbook.Sheets("invoerschermartikelen")

ActiveWorkbook.SaveAs Filename:="F:\Testfacturen\" & [K2] & ".xls"
End With
ActiveWorkbook.Close

End Sub

We zijn er bijna.. :shocked:

Cruimel

 

[Warme bakkertje]

Cruimel, aangezien ik niet beschik over versie 2007 kan ik hem niet testen, dus als iemand zich geroepen voelt. In bijlage een foutloos werkende code in versie 2003.

Mvg

Rudi

 

[snb]

Sub Bladen_opslaan()
  ThisWorkbook.Sheets(Array("invoerschermartikelen", "factuur")).Copy
  with activeworkbook
    .SaveAs "F:\Testfacturen\" & .Sheets("invoerschermartikelen").[K2] & ".xls"
     .Close
  End with
End Sub

 

[Cruimel]

Hoi Snb en Rudi,

Code wordt al korter ..
Hij geeft helaas direct al een foutmelding op de eerste commando regel. Ik heb er nog wat proberen te sleutelen, maar dan verplaatst de foutmelding zich naar de derde commando regel.
Jammer dat Rudi de 2007 versie niet heeft, op mijn beurt kan ik weer niet het "rar" zip bestand openen.
Ik doe sluit nogmaals het bestand bij, als 2003 en als 2007 versie, hopelijk geeft dat weer meer grip hierop.
Wel heel super om jullie input te zien hoor.. T'is ook wel een uitdaging.

Cruimel