Macro loopt vast bij "ActiveSheet.Paste"

[assessor]

Omdat mijn VB kennis nog redelijk beneden peil is heb ik met Macros het een en ander aan elkaar gesleuteld. Misschien niet elegant maar het werkt... op mijn PC.
Op de Laptop op mijn werk echter werkt het niet. (beide: Excel 2003 SP2 UK version)
Ik zal hier ter verduidelijking een stukje code toevoegen.

Sub Paint()
'
Sheets("ALL").Select

Range("B1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=2, Criteria1:="=*a*", Operator:=xlAnd
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = 3
Selection.Font.ColorIndex = 2
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Paste

Range("A1").Select
Sheets("ALL").Select

Selection.AutoFilter Field:=2, Criteria1:="=*b*", Operator:=xlAnd
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = 4
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("B").Select
ActiveSheet.Paste 'Hier gaat het fout

Range("A1").Select
Sheets("ALL").Select

Selection.AutoFilter Field:=2, Criteria1:="=*c*", Operator:=xlAnd
Range("A2:B2").Select

..... en zo gaat dit een tijdje door.

Het probleem doet zich voor bij "ActiveSheet.Paste" dan krijg ik een:
_____________________________________

Run-time error '1004':
Paste method of Worksheet class failed
_____________________________________

Zodra ik in het venster op "debug" klik zie ik dat de "paste" actie wordt uigevoerd, als ik dan "ActiveSheet.Paste" uitREM dan loopt de code door tot de volgende "ActiveSheet.Paste"

Dit gebeurt alleen vanaf de tweede "ActiveSheet.Paste" in deze code.

Als iemand enig idee heeft dan hoor ik dit graag.
Ook stat ik ervoor open als iemand een elegantere oplossing voor dit stukje code heeft.

vast dank

 

[Wigi]

Selecteren is normaal gezien niet nodig. En voor het kopiëren is er ook een simpele oplossing:

Dit

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("B").Select
ActiveSheet.Paste

doe je normaal zo:

Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy Sheets("B").Range("celwaarhetnaartoemoetgekopieerdworden")

Pas ook de rest aan nu je dit weet.

Wigi

 

[Haaren101]

Ik vind dit ook wel een mooie als je alle data in een sheet moet selecteren:

Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy Sheets("B").Range("celwaarhetnaartoemoetgekopieerdworden")

Ron

 

[assessor]

Nog niet helemaal

Wigi & Haaren101

Dank voor jullie snelle reactie.

Eleganter is het zeker en ik ga het straks in mijn "thuis versie" gelijk proberen toe te passen. De "werk versie" zal tot morgen moeten wachten, er staan voor vandaag andere zaken op de agenda.

Ik ga het julie laten weten.

 

[assessor]

Het gaat de goede kant op

Geen van de twee stukjes code deed echt wat ik wil, d.w.z. alle twee lieten ze wel iets achter, de ene nam alleen de eerste drie kolommen mee, de ander alleen de eerste rij.

Het heeft toch gegeven wat ik wou, een zet in de goede richting. Mijn zelfde stukje code ziet er nu als volgt uit.

Sub Paint()
'
Sheets("ALL").Select
Range("B1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=2, Criteria1:="=*a*", Operator:=xlAnd
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = 3
Selection.Font.ColorIndex = 2
Range("A1", Range(Selection, ActiveCell.SpecialCells(xlLastCell))).Copy Sheets("A").Range("A1")

Sheets("ALL").Select

Selection.AutoFilter Field:=2, Criteria1:="=*b*", Operator:=xlAnd
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = 4
Range("A1", Range(Selection, ActiveCell.SpecialCells(xlLastCell))).Copy Sheets("B").Range("A1")

Sheets("ALL").Select

Selection.AutoFilter Field:=2, Criteria1:="=*c*", Operator:=xlAnd
Range("A2:B2").Select

Of het ook het probleem op mijn werk laptop gaat verhelpen zal ik jullie morgen laten lezen. Ik ga nog even door met het toepassen van het geleerde op de rest van mijn code.

 

[Wigi]

Ik ga nog even door met het toepassen van het geleerde op de rest van mijn code.

Inderdaad, dat is een goed idee. Dit bv.

Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = 4

schrijf je veel efficiënter als

Range("A2:B2", Range("A2:B2").End(xlDown)).Interior.ColorIndex = 4

Zo min mogelijk Select. Dat vertraagt de code en doet het scherm "flitsen".

Wigi

 

[assessor]

Wigi,

Jou kreet "Selecteren is normaal gezien niet nodig" heeft mij al heel wat extra regels code bespaard. Hier en daar wil het nog niet helemaal lukken maar ik leer er van...

Het echte probleem is er helaas nog steeds. Ook met deze gewijzigde code, op mijn thuis PC werkt het feilloos, op mijn werk laptop loopt het vast op hetzelfde punt.

Nu dus:
Range("A1", Range(Selection, ActiveCell.SpecialCells(xlLastCell))).Copy Sheets("B").Range("A1")
en verderop bij:
Range("A1", Range(Selection, ActiveCell.SpecialCells(xlLastCell))).Copy Sheets("C").Range("A1")
etc:

Het probleem is exact hetzelfde gebleven. Enig idee hierover?

 

[Wigi]

Om dat te beoordelen hebben we het bewuste bestand nodig, inclusief de hele code.

 

[assessor]

Wigi,
Daar is weer dat probleem van "gevoelige informatie"
Zodra ik helemaal "out of options" ben dan zal ik proberen het programmatje met nepdata te voorzien. Ik ga het je zeker laten weten.

groet, assessor

 

[assessor]

Heb uiteindelijk "Selection.Autofilter" moeten laten varen, laptops (vreemd genoeg alleen de verschillende laptops op mijn werk) liepen hierop vast. Heb mijn filtering nu met "Select Case" voor elkaar.

Ik heb nog een paar andere zaakjes die niet helemaal gaan zoals ik wil maar wil hier zelf nog even verder mee stoeien. Als ik helemaal vast loop hoop ik dat ik weer een beroep op jullie kan doen. Wigi, nogmaals hartelijk dank.

mvg, assessor