Verzamelstaat maken

[Ron321]

IK heb in mijn rapport een knop gemaakt waarmee ik het rapport op kan slaan onder een rapportnummer welke in het rapport zelf ingevuld wordt.
In dit rapport staat ook een cel met de locatie waar het rapport opgeslagen wordt.

Nu probeer ik een macro te maken die een sheet "Rapporten" opent (deze sheet staat dus in diezelfde map, dus de macro moet daarnaar kijken), daarin bepaalde gegevens (cellen P1 t/m U1) plakt uit het rapport dan de sheet weer opslaat en afsluit.

Daarbij moet hij wel steeds op de volgende lege rij beginnen.

Sub Macro5()

' Macro5 Macro

'
Range("P1:U1").Select
Selection.Copy
Application.CutCopyMode = False
Workbooks.Open Filename:= _
"D:\Mijn documenten\nieuw\Rapporten.xls"
ActiveSheet.Paste
Range("A3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Dit is de code die ik heb opgenomen met de macrorecorder, maar ik weet niet precies hoe ik deze verder aan moet passen aan bovenstaande eisen.

Heeft iemand een idee?

 

[jheesterbeek]

Selection.Copy
Application.CutCopyMode = False

je kopieert iets naar het klembord en maakt vervolgens het klembord leeg


Wil je iets kopieren uit de openstaande sheet, naar Rapporten.xls
of omgekeerd?

 

[Ron321]

Inderdaad vanuit openstaand rapport naar "Rapporten.xls".

De reden dat ik het via het klembord heb gedaan is dat hij dan de waardes kopieert ipv de formules.
Dat zou ik natuurlijk ook kunnen doen via plakken speciaal.

 

[jheesterbeek]

Behalve het leegmaken van het klembord zou je code goed moeten zijn:

Sub Macro5()
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
   "D:\Mijn documenten\nieuw\Rapporten.xls"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("A3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Ron321]

Wat ik eigenlijk wil is dat hij in cel N1 kijkt voor de locatie waar Rapporten.xls zich bevindt en dat hij ipv range A3 select de eerste volgende vrije cel in kolom A opzoekt.

 

[jheesterbeek]

Zou je dit eens kunne proberen....

Sub Macro5()
Dim VrijeRij
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
   Activesheet.range("N1").value & "Rapporten.xls"
Do until cells(VrijeRij,1).value = "" 
  cells(VrijeRij,1).select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Ron321]

Ik krijg de melding: compileerfout do zonder loop

 

[jheesterbeek]

Een loopje vergeten:

Sub Macro5()
Dim VrijeRij
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
   Activesheet.range("N1").value & "Rapporten.xls"
Do until cells(VrijeRij,1).value = "" 
  cells(VrijeRij,1).select
  VrijeRij = VrijeRij + 1
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Ron321]

Nu krijg ik:

Fout 1004 tijdens uitvoering
Door de toepassing of door object gedefinieerde fout.

Foutopsporing:

Dim VrijeRij
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
ActiveSheet.Range("N1").Value & "\Rapporten.xls"
Do Until Cells(VrijeRij, 1).Value = ""
Cells(VrijeRij, 1).Select
VrijeRij = VrijeRij + 1
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[jheesterbeek]

Ik heb het maar een keer getest in plaats van uit mijn hoofd code te typen:

Dim VrijeRij, Directory
Directory = ActiveSheet.Range("N1").Value & "\"
VrijeRij = 1
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
   Directory & "Rapporten.xls"
Do Until ActiveSheet.Cells(VrijeRij, 1).Value = ""
  ActiveSheet.Cells(VrijeRij, 1).Select
  VrijeRij = VrijeRij + 1
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close

Sorry dat het zo''n langdradig proces is geworden....

 

[Ron321]

Sorry dat het zo''n langdradig proces is geworden....

Dat geeft niet

Hij gaat nog niet naar de volgende rij in het bestand Rapporten.xls, maar plakt het steeds op de eerste rij.

 

[jheesterbeek]

Hij start op rij 1 en gaat opzoek naar de eerste lege cel die die tegenkomt.
Heb je A1 leeg?

 

[Ron321]

In A1 staat de titel van die kolom en ik heb de titels geblokkeerd.
Ik wil dus dat hij begint in A2 (had ik misschien iets eerder moeten vermelden ) en dan verder gaat naar beneden.

 

[Ron321]

Hij plakt het dus steeds in A2 (over de vorige gegevens heen).

 

[jheesterbeek]

Dim VrijeRij, Directory
Directory = ActiveSheet.Range("N1").Value & ""
[B][U]VrijeRij = 2[/U][/B]
Range("P1:U1").Select
Selection.Copy
Workbooks.Open Filename:= _
   Directory & "Rapporten.xls"
Do Until ActiveSheet.Cells(VrijeRij, 1).Value = ""
  ActiveSheet.Cells(VrijeRij, 1).Select
  VrijeRij = VrijeRij + 1
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close

Als bovenstaande code niet werkt, zou je je file op de mail of het forum moeten plaatsen, dan kna ik ff proberen...

 

[Ron321]

Hij blijft het in A2 plakken.
Bestand is te groot om hier te plaatsen, hoe kan ik je mailen?

 

[jheesterbeek]

hier stond mijn adres...)

 

[Ron321]

:thumb: