kolommen splitsen

[rik uit gorinchem]

Goedenmiddag Forumleden,

 

In een bestand heb ik 4 lange kolommen die ik wil splitsen zodat er 2 x 4 kolommen op één pagina passen.

Op de eerste pagina werkt dit perfect, maar op de volgende pagina('s) staan de vier kolommen rechts i.p.v. links ( A,B,C,D)

Met wat ik ook probeer, krijg ik het niet voor elkaar.

 

Heel graag wil ik hier wat hulp bij, zodat ik verder kan.

Alvast bedankt.

 

De code die ik gebruik is de volgende:

 

Sub Kolommen_splitsen()
Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = False
    
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
  Dim lrow As Long
  With Sheets("Blad1")
   lrow = .HPageBreaks.Item(1).Location.Row
        .Range("A1:D1").Copy .Range("E1")
           With .Cells(lrow, 1).Resize(Range(.Cells(lrow, 1), .Cells(lrow, 1).End(xlDown)).Rows.Count, 4)
            .Copy Range("E1")
            .ClearContents
           End With
          '.Columns("E:H").AutoFit
          .PrintPreview
     .Cells(1, 4).CurrentRegion.Offset(1).Copy .Cells(lrow, 1)
     '.Columns("A:B").Clear
     '.Columns("C:D").Clear
   End With
End Sub

 

Kolommen_splitsen.xlsm

[alpha]

Probeer dit:

Sub macro1()
Dim lr1 As Integer, lr2 As Integer
With Sheets("Blad1")
lr1 = .Cells(.Rows.Count, 1).End(xlUp).Row
lr2 = CInt(lr1 / 2) + 1: If WorksheetFunction.IsOdd(lr2) Then lr2 = lr2 + 1
.Range(.Cells(lr2, 1), .Cells(lr1, 4)).Cut .Cells(1, 6)
With .Columns("a:i")
.Font.Size = 10
.AutoFit
End With
End With
End Sub

[rik uit gorinchem]

Hallo Alpha,

 

Dit werkt perfect zo.

 

Hartelijk dank voor deze oplossing.

 

Met vriendelijke groet:

Rik

 

 

Dit topic mag op opgelost worden gezet.