Meerdere selecties sorteren

[Peer44]

Hallo,

Hoe kan ik meerdere selecties sorteren op basis van gegevens in kolom a?
in de bijlage een voorbeeld.

Ik wil de kolommen A,B,C en G en H laten sorteren op basis van de gegevens in A2:A5 met de macro recorder kom ik er helaas niet aan uit.
Kolommen D, E, F moeten ongewijzigd blijven.

Alvast bedankt.Bekijk bijlage sorteren meerdere selecties.xlsm

 

[slpe]

Moeten de gegevens in kolom D en verder blijven staan of ook mee sorteren?

 

[Peer44]

d , e , f moeten niet worden gesorteerd.

 

[VenA]

Wat is het doel hiervan? Normaal staat er in een rij gegevens die bij elkaar horen. Of het in één keer kan weet ik niet. Je kan even een tempkolom laten aanmaken met de waarden uit kolom A en vervolgens sorteren op kolom A en in dit voorbeeldje kolom I. En vervolgens kolom i weer leegmaken.

Sub Test()
Dim i As Long
With Sheets("Blad1")
    .Range("I1") = "temp"
    For i = 2 To .UsedRange.Rows.Count
      .Cells(i, 9) = .Cells(i, 1)
    Next i
End With
End Sub

 

[Peer44]

Ben het met je eens dat normaal de gegevens bij elkaar horen.
een tempkolom is een werkbare oplossing, dank voor het meedenken.

 

[VenA]

Ik nog steeds benieuwd naar het doel hiervan.

Met deze code moet het denk ik wel werken. De kolommen A t/m C en G t/m H worden gesorteerd op basis van de waarde in kolom A.

Sub Test()
Application.ScreenUpdating = False
Dim i As Long, Ar As Long
With Sheets("Blad1")
    Ar = .UsedRange.Rows.Count
    For i = 2 To Ar
      .Cells(i, 9) = .Cells(i, 1)
    Next i
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=Range("A2:A" & Ar), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .SetRange Range("A1:C" & Ar)
            .Header = xlYes
            .MatchCase = False
            .Apply
            With .SortFields
                .Clear
                .Add Key:=Range("I2:I" & Ar), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .SetRange Range("G1:I" & Ar)
            .Header = xlYes
            .MatchCase = False
            .Apply
        End With
    .Columns(9).ClearContents
End With
Application.ScreenUpdating = False
End Sub