Kolommen verdelen over pagina

[kabebanaan]

Hallo,

Is er ook een eenvoudige manier om een grote kolom op te splitsen in meerdere kolommen op één pagina?

Even een eenvoudig voorbeeld:
Stel je hebt in kolom "A" 1000 waarden staan. Je print dit uit en je krijgt 10 pagina's.
Je zou per pagina ook 500 waarden kunnen krijgen door per pagina 5 kolommen te maken, met in deze kolommen 100 waarden. Bij het uitprinten krijg je dan 2 pagina's.

Om dit te bereiken doe ik het zelf met knippen/plakken .... werkt natuurlijk ook, maar kan dit eenvoudiger?

 

[LucB]

Karel,

Deze code doet het truje.

Sub OpsplitsTabel()
Application.ScreenUpdating = False
Dim col As Integer, x As Integer, y As Integer
Dim i As Integer, j As Integer, cnt As Integer
Dim c As Integer
Dim myRng
col = 10 'aantal kolommen waarin je kolom A wilt splitsen.
myRng = "A1:A1000" 'De range die je wilt opsplitsen.
'In dit geval blijft kolom A intact evt. met de hand verwijderen.
Columns(2).Resize(, col).Clear
x = Range(myRng).Count
y = Int(x / col) + IIf(x - (col * Int(x / col)) <> 0, 1, 0)
For i = 1 To col
For j = 1 To y
cnt = cnt + 1
c = Range(myRng)(cnt)
Cells(0 + j, 0 + i) = c
If cnt = x Then GoTo Einde
Next j
Next i
ActiveSheet.Columns("A:K").AutoFit
Application.ScreenUpdating = True
End Sub

 

[kabebanaan]

Luc,

Ik krijg dan een compileerfout. Bij
If cnt = x Then GoTo Einde valt ie over "Goto Einde" .... naam is niet gedefineerd.

 

[LucB]

Sorry Karel,

Na Next i
Invoegen:

Einde:

(Inclusief de ":")

 

[kabebanaan]

Volgende foutmelding in:
c = Range(myRng)(cnt)

Fout 13 tijdens uitvoering:
Typen komen niet met elkaar overeen

 

[LucB]

Karel,

Dit draait bij mij als een zonnetje.

Sub OpsplitsTabel()
Application.ScreenUpdating = False
Dim col As Integer, x As Integer, y As Integer
Dim i As Integer, j As Integer, cnt As Integer
Dim c As Integer
Dim myRng
col = 10 'aantal kolommen waarin je kolom A wilt splitsen.
myRng = "A1:A1000" 'De range die je wilt opsplitsen.
'In dit geval blijft kolom A intact evt. met de hand verwijderen.
Columns(2).Resize(, col).Clear
x = Range(myRng).Count
y = Int(x / col) + IIf(x - (col * Int(x / col)) <> 0, 1, 0)
For i = 1 To col
For j = 1 To y
cnt = cnt + 1
c = Range(myRng)(cnt)
Cells(0 + j, 0 + i) = c
If cnt = x Then GoTo Einde
Next j
Next i
Einde:
ActiveSheet.Columns("A:K").AutoFit
Application.ScreenUpdating = True
End Sub

 

[kabebanaan]

Jammer dat 't hier niet lukt.

Zie bijlage.

 

[LucB]

Karel,
Nog één mogelijkheid.

Verander de 5e regel (Dim c As Integer) in:

Dim c As Variant

Ik had er niet aan gedacht dat in Kolom A tekst stond.

Nogmaals mijn excuses.

 

[kabebanaan]

Okee Luc, bedankt voor je hulp !

Nog 1 vraagje .... In dit voorbeeld hebben we 1 kolom genomen .......stel ik wil zoiets doen met 2 kolommen? Wat dien ik dan te veranderen in de code?

 

[LucB]

Karel,

De code is nu geschikt voor getallen en tekst.

Wat je vraag betreft:
Je zou kolom B naar een ander blad kunnen knippen naar kolom A. Daar de macro uitvoeren en het resultaat terug kunnen knippen naar het eerste blad.

Blij dat alles nu OK is.

Tot een volgende keer.

 

[kabebanaan]

Resultaat is nog niet helemaal wat ik wilde .... sorry voor m'n iets verwarrende vraagstelling.

Maar stel je hebt in kolom "A" getallen staan 1 t/m 1000.
Wanneer ik dan de code uitvoer, en ik wil 4 kolommen hebben, dan krijg ik op pagina 1 onderaan:

56 307 558 809

en op het laatste blad :

247 498 749 1000

Zou het graag zo willen hebben dat op pagina 1 de getallen 1 t/m 224 komen te staan.

(wat ik niet begrijp is dat ik niet precies 4 kolommen krijg die 250 getallen lang zijn???)