Variabel bereik kopieeren

[robinvdveeken]

Welgewaardeerde forumleden,

Ik heb een script geschreven waarmee ik gegenereerde tabelen kopieer van het ene naar het andere tabblad.
De te kopieeren tabellen staan op diverse tabbladen, deze moeten onder elkaar op een bestaand tabblad komen.
Op het originele tabblad staan de tabbladen 3 regels uit elkaar.
De clue is, om het bereik te bepalen tot waar gekopieerd moet worden.
Onderstaand script werkt, het duurt alleen heeeel lang.

While empty_regel < 5
    
   
    Regel_nr = Regel_nr + 1
        
    If Sheets("Power").Range("AG" & Regel_nr) <> "" Then 'Omschrijving moet ingevuld zijn
       empty_regel = 0
    Else

       empty_regel = empty_regel + 1
       
    End If


  
Wend

Sheets("Power").Range("AF10" & ":AG" & Regel_nr + 1).Copy
With Range("A" & Blad_regel_nr).Offset(1):
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats


End With

Hierin wordt eerst bekeken tot waar het bereik loopt, en dan gekopieerd.
Heeft iemand een idee hoe dit sneller kan?

Alvast bedankt.

Groeten,
Robin

 

[wiki]

Je vraag is niet helemaal duidelijk, maar heb je iets aan deze regel

A1 is de begincel van je bereik cq tabel

Range("a1", Cells.Find(What:="*", After:=[a1], SearchDirection:=xlPrevious)).Name = "Myrange"
Range("myrange").select

en bevat je code

sub()
application.screenupdating=false
application.calculation=xlcalculationmanual

jouw code

application.screenupdating=true
application.calculation=xlcalculationautomatic

dit vernelt de uitvoer

gr wim

 

[robinvdveeken]

Beste Wim,

Bedankt voor je reactie.
De screenupdate had ik al in mijn code. Manuele calculatie zal ik erin opnemen. Eerst nog even opzoeken wat het exact doet.

Mijn vraag zal ik anders stellen:

Stel je wil de bijlage, met gevulde tabellen welteverstaan. inclusief opmaak kopieeren naar een ander tabblad.

In de werkelijke situatie zijn het zeven verschillende tabbladen met tabellen onder elkaar kopieeren op 1 tabblad. Simpel een range kopieeren gaat veel sneller. Het aantal tabellen, en dus het bereik varieert echter sterk.

Ik heb het gebrobeerd met

.SpecialCells(xlConstants)

Dit werkt echter niet doordat er witregels tussen de tabellen zitten. Deze moeten ook behouden blijven.

Met de huidige code duurt dit zo'n 11 minuten, afhankelijk van het aantal tabellen. Dit lijkt mij erg veel. Ik schat dat het hierbij gaat om in totaal zo'n 180 tabellen.

Alvast bedankt.

Groeten,
Robin

Groeten,
Robin

 

[wiki]

Heb je de bovenste code geprobeerd?

Sub test()
Range("a1", Cells.offsett(Find(What:="*", After:=[a1], SearchDirection:=xlPrevious), 1, 1)).Name = "Myrange"
Range("myrange").Select
End Sub

hiermee selecteer ik al je tabellen incl. de witregels (wel even waarde in d2277 zetten omdat je tabellen nu leeg zijn)

gr wim