Kolommen in andere volgorde

[Jack Nouws]

Sub Macro2()
    With Blad1
        col1 = .UsedRange.Columns(6)
        col2 = .UsedRange.Columns(5)
        col3 = .UsedRange.Columns(3)
        col4 = .UsedRange.Columns(4)
            Blad2.Cells(1, 1).Resize(UBound(col1)) = col1
            Blad2.Cells(1, 2).Resize(UBound(col2)) = col2
            Blad2.Cells(1, 3).Resize(UBound(col3)) = col3
            Blad2.Cells(1, 4).Resize(UBound(col4)) = col4
    End With
End Sub

hallo
Ik wil graag 4 willekeurige kolommen van Blad1 in een bepaalde volgorde in blad2 kopieeren.
Dat lukt met deze code maar kan het bijv ook om de kolommen in een Array te plaatsen en
daan op Blad2 te zetten?

BvD, JN

 

[alphamax]

Option Explicit

Public Sub Main()
    Dim avntColumns As Variant
    Dim iavntColumns As Long
        With Application
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        avntColumns = Array(6, 5, 3, 4)
        For iavntColumns = LBound(avntColumns) To UBound(avntColumns)
            Sheets(1).Columns(avntColumns(iavntColumns)).Copy Destination:=Sheets(2).Columns(iavntColumns + 1)
        Next
        With Application
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
        End With
End Sub

 

[HSV]

Ook nog.

Sub hsv()
Dim sn, hs_v
sn = Blad1.Cells(1).CurrentRegion
     Blad1.Cells(1).CurrentRegion.Name = "bereik"
hs_v = Application.Transpose(Split(Join([transpose(row(bereik))])))
     Blad2.Cells(1).Resize(UBound(sn), 4) = Application.Index(sn, hs_v, Array(6, 5, 3, 4))
End Sub