Automatisk sortering af værdier fra flere kolonner

Hos mig virker din kode ikke hvis navnet begynder med et bogstav før "H"

denne kode gør



ang dit andet problem vender jeg tilbage

Jan

denne kode til sort af kolonne A til C virker


tænker du at alle navne i kolonne A til C skal kopieres over i D og derefter sorteres

Jan

Det fulde forslag fra mig



Jan

Ja, alle navne fra kolonne ABC skal sorteres i kolonne D.

Ok, det virker....men hvis jeg sletter et navn igen, så efterlader regnearket cellen tom. Det gør det ikke hvis man benytter den "oprindelige" kode fra mit første indlæg, der rykker det automatisk navnene op og efterlader ikke nogen tomme celler.

Ellers virker det.

Lige en sidste ting....
Hvad skal jeg ændre i koden hvis jeg gerne vil udvide det fra kolonne ABC til kolonne ABCDEFGH der så skal sorteres i kolonne I

Ang. oprindelig kode så sorterede den her holdet med .
ser lige på koderne og vender tilbage, måske først i morgen

Ja, men det kunne "omgås" ved at kalde holdene - 1.hold, 2.hold osv - for tallet kommer før A i sorteringen.

Jeg har forsøgt at rode med det sidste kode eksempel, for at udvide det til kolonne A-H og en samlet sortering i kolonne I, men må bare indrømme - BAMBI PÅ GLAT IS....:-)

Ellers MANGE tak for hjælpen og jeg kan sagtens vente.

Jon

Her er et system som ikke sorterer 1 række og som kan udvides

Kan simpelthen ikke få det til at virke.
Har ændret til følgende.

Option Explicit
Dim Lrow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
  Vis (False)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Call AllSort(Range("A2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Call AllSort(Range("B2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        Call AllSort(Range("C2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        Call AllSort(Range("D2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Call AllSort(Range("E2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Call AllSort(Range("F2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        Call AllSort(Range("G2"))
        Call CopyABCDEFGH
    End If
   
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        Call AllSort(Range("H2"))
        Call CopyABCDEFGH
    End If
   
  Vis (True)
End Sub
Sub AllSort(rCell As Range)
    Dim rCells As Range
        Lrow = LastRow(rCell) + 20
        Set rCells = Range(rCell, Cells(Lrow, rCell.Column))
        With rCells
            .Sort Key1:=rCell, Order1:=xlAscending, _
                  Header:=xlNo, _
                  OrderCustom:=1, _
                  MatchCase:=False, _
                  Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
        End With
        Lrow = 0
       
End Sub
Private Function LastRow(rCell As Range) As Long
    Dim Lrow As Long
    Lrow = rCell.End(xlDown).Row
    LastRow = Lrow
End Function
Sub CopyABCDEFGH()
    Dim rCol As Range, rSum As Range
    Dim rCellA As Range, rCel As Range
    Dim Lrow As Long
    Dim Count As Integer, iCol As Integer
    ' her under sættes sidste kolonne med holddata
    Const LastCol As String = "H2"
   
    ' her under renses sammenflettet kolonne
    Set rCellA = Range(LastCol)
    Set rCellA = rCellA.Offset(0, 1)
    Set rSum = rCellA
    If Not rCellA.Value = "" Then
        Lrow = LastRow(rCellA)
        Set rCol = Range(rCellA, Cells(Lrow, rCellA.Column))
        rCol.Clear
    End If

    ' her under overføres navne
    Count = 1
    For iCol = 1 To Range(LastCol).Column
        Set rCellA = Cells(2, iCol)
        Lrow = LastRow(rCellA)
        Set rCol = Range(rCellA, Cells(Lrow, rCellA.Column))
       
        For Each rCel In rCol
            Count = Count + 1
            Cells(Count, 4) = rCel
        Next
    Next iCol
   
    Call AllSort(rSum)
End Sub
Sub Vis(bVis As Boolean)
    Application.ScreenUpdating = bVis
End Sub



DEBUGGEREN SIGER FEJL VED:
            .Sort Key1:=rCell, Order1:=xlAscending, _
                  Header:=xlNo, _
                  OrderCustom:=1, _
                  MatchCase:=False, _
                  Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal

Regnearket ligger her, hvis det er nogen hjælp

http://www.filedropper.com/test_338

Jon

Ny Ver.



Mvh Jan

BINGO !!!!!!

Det virker.

MEGA mange tak...

Jon

Velbekomme