Celbereik kopieeren en opslaan

[Jack Nouws]

Goede morgen iedereen,

Ik zou graag een macro willen maken om een celbereik van B2 : P71 als nieuw bestand op te slaan naar een bstaande map. Dit bestand wil ik de naam geven van cel N:14.
Het is de bedoeling dat bij het opslaan het geactiveerde blad niet wordt verlaten.
Kolom en Rij opmaak moeten gehandhaafd blijven.
Formules mogen niet mee gekopieerd worden.

Groetjes Jack

 

[Roncancio]

Onderstaande macro:
- opent een nieuw bestand
- Kopieert het bereik B2 t/m P71 naar het nieuwe bestand
- Zet daar de layout en waardes neer. (géén formule)
- Slaat het nieuwe bestand op met de celwaarde van N14.

Sub Opslaan()
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("B2:P71").Copy
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlFormats
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues
    NieuwBest.SaveAs Filename:=ThisWorkbook.Worksheets(1).Range("N14")

End Sub

Met vriendelijke groet,


Roncancio

 

[dirktimm]

Celereik kopieeren en opslaan

Zie ook hier:
http://office.webforums.nl/forum/viewtopic.php?t=34523

Groet

Dirk

 

[Jack Nouws]

Onderstaande macro:
- opent een nieuw bestand
- Kopieert het bereik B2 t/m P71 naar het nieuwe bestand
- Zet daar de layout en waardes neer. (géén formule)
- Slaat het nieuwe bestand op met de celwaarde van N14.

Sub Opslaan()
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("B2:P71").Copy
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlFormats
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues
    NieuwBest.SaveAs Filename:=ThisWorkbook.Worksheets(1).Range("N14")

End Sub

Met vriendelijke groet,


Roncancio

Die van jou is korter en makkelijker denk ik want na een half uur puzzelen kwam ik hier op.

Sub Opslaan()
Application.displayalerts=false
ActiveSheet.Copy
With Workbooks(Workbooks.Count)
.Sheets(1).Range("B2:P71").Copy
With .Sheets.Add
.Paste .Cells(2,2)
.range("B2:P71").value=.range("B2:P71").value
End With
.Sheets(2).Delete
.SaveAs .sheets(1).range("N14")
.Close False
End With
Application.displayalerts=true
End Sub

OK in ieder geval bedankt en tot de volgende keer maar weer.
(Er spookt trouwens alweer wat door m'n hoofd maar dat komt nog wel)

Groetjes Jack

 

[Jack Nouws]

Onderstaande macro:
- opent een nieuw bestand
- Kopieert het bereik B2 t/m P71 naar het nieuwe bestand
- Zet daar de layout en waardes neer. (géén formule)
- Slaat het nieuwe bestand op met de celwaarde van N14.

Sub Opslaan()
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("B2:P71").Copy
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlFormats
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues
    NieuwBest.SaveAs Filename:=ThisWorkbook.Worksheets(1).Range("N14")

End Sub

Met vriendelijke groet,


Roncancio

Ik heb toch nog een vraag hierover die formule van jou. Bij jou word de inhoud van N14 niet als nieuw bestandsnaam gebruikt. Is dat overigens wel mogelijk???
Ik dacht aan zoiets als hieronder maar het werkt nog niet helemaal naar wens.

    Application.Goto Reference:="Werkblad"
    Selection.Copy
    Copy.SaveAs Filename:="C:\Documents and Settings\Mijn documenten\Faktuur bewaren\Faktuur " & Range("N14").Value & ".xlsm"

Groeten Jack

 

[Roncancio]

Ik heb toch nog een vraag hierover die formule van jou. Bij jou word de inhoud van N14 niet als nieuw bestandsnaam gebruikt. Is dat overigens wel mogelijk???
Ik dacht aan zoiets als hieronder maar het werkt nog niet helemaal naar wens.

    Application.Goto Reference:="Werkblad"
    Selection.Copy
    Copy.SaveAs Filename:="C:\Documents and Settings\Mijn documenten\Faktuur bewaren\Faktuur " & Range("N14").Value & ".xlsm"

Groeten Jack

Bij mij werkt het naar behoren.
Wat gaat er niet goed op die regel bij jou?

Met vriendelijke groet,


Roncancio

 

[Jack Nouws]

Bij mij werkt het naar behoren.
Wat gaat er niet goed op die regel bij jou?

Met vriendelijke groet,


Roncancio

Nou ik heb met die formule van mij een nieuw bestandsnaam. En met die formule van jou sla je een nieuw bestand op met de instellingen er om heen. Ik probeer er 1 formule van te maken maar dat lukt me niet!!!


Groet Jack

 

[Jack Nouws]

Nou ik heb met die formule van mij een nieuw bestandsnaam. En met die formule van jou sla je een nieuw bestand op met de instellingen er om heen. Ik probeer er 1 formule van te maken maar dat lukt me niet!!!


Groet Jack

Sorry helemaal verkeerd begrepen die formule van je. Het is perfect. Dank je en mijn excuus!

Groeten Jack:thumb:

 

[Jack Nouws]

Sorry helemaal verkeerd begrepen die formule van je. Het is perfect. Dank je en mijn excuus!

Groeten Jack:thumb:

Beste Roncancio

Er komt toch nog een foutmelding betreft de opmaak;

Sub WerkbladNaam()
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("B2:P71").Copy
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlFormats
[COLOR="Red"]    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues[/COLOR]
    NieuwBest.SaveAs Filename:="C:\Documents and Settings\Mijn documenten\Faktuur bewaren\Faktuur " & Range("N14").Value & ".xlsm"

End Sub

foutmelding is:

fout 1004 tijdens uitvoering

Voor deze bewerking moeten alle
cellen dezelfde afmetingen hebben.

wat kan ik hier aan Doen?

 

[Roncancio]

Beste Roncancio

Er komt toch nog een foutmelding betreft de opmaak;

Sub WerkbladNaam()
Set NieuwBest = Workbooks.Add
    ThisWorkbook.Worksheets(1).Range("B2:P71").Copy
    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlFormats
[COLOR="Red"]    NieuwBest.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues[/COLOR]
    NieuwBest.SaveAs Filename:="C:\Documents and Settings\Mijn documenten\Faktuur bewaren\Faktuur " & Range("N14").Value & ".xlsm"

End Sub

foutmelding is:




wat kan ik hier aan Doen?

Dat komt zeer waarschijnlijk omdat er samengevoegde cellen in het bereik zitten.
Sowieso geven samengevoegde cellen regelmatig problemen.

Met vriendelijke groet,


Roncancio