Gennemgå alle kundeark og opsamle de 10 største værdier i et array

skal det tømmes i et bestemt ark?

Ja kald bare arket "Weekly report" som dermed også er det eneste ark som den ikke skal søge efter data i

Public Sub sortTop10()
Dim ws As Worksheet, saveWs As Worksheet
Dim erSaveWs As Boolean
Dim topTenDob(9) As Double, nuTallet As Double, forwDob As Double
Dim topTenNavn(9) As String, nuNavn As String, forwNavn
Dim counter As Integer, statCell As Range

erSaveWs = False
For Each ws In Worksheets
    ws.Select
    If ws.Name = "Weekly report" Then
        Set saveWs = ActiveSheet
        erSaveWs = True
    Else
        nuTallet = Range("F10").Value
        nuNavn = Range("A1").Value
        For i = LBound(topTenDob) To UBound(topTenDob)
            If topTenDob(i) < nuTallet Then
                forwDob = topTenDob(i)
                forwNavn = topTenNavn(i)
                topTenDob(i) = nuTallet
                topTenNavn(i) = nuNavn
                taller = i + 1
                For y = taller To UBound(topTenDob)
                    nuTallet = topTenDob(y)
                    nuNavn = topTenNavn(y)
                    topTenDob(y) = forwDob
                    topTenNavn(y) = forwNavn
                    forwDob = nuTallet
                    forwNavn = nuNavn
                Next
            End If
           
        Next
    End If
   
Next

If erSaveWs = False Then
    Set saveWs = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    saveWs.Name = "Weekly report"
End If

saveWs.Select
Set statCell = Range("B2")
Range("B1").Value = "Top 10"
For i = LBound(topTenDob) To UBound(topTenDob)
    taller = 1 + i
    statCell.Offset(i, -1).Value = taller
    statCell.Offset(i, 0).Value = topTenNavn(i)
    statCell.Offset(i, 1).Value = topTenDob(i)
Next
End Sub

Det er ikke så pænt men det skulle gerne virke...

Det er også mulig og benytte excel's "sortmetode"

Hvis du har et ark nr 1 til oversikt, vil denne hente data fra alle de andre arkene.

Her blir ALLE sortert i en liste, men det er en enkel sak å slette fra nr. 11 og ned.


Public Sub test()
    Sheets(1).Select
    For n = 2 To Sheets.Count
        Sheets(1).Range("C1").Offset(n - 1, 0) = Sheets(n).Range("A1").Value
        Sheets(1).Range("C1").Offset(n - 1, 1) = Sheets(n).Range("F10").Value
    Next
   
    ActiveWorkbook.Worksheets("Ark1").Sort.SortFields.Add Key:=Range("D2:D" & Sheets.Count), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("C2:D" & Sheets.Count)
        .Apply
    End With
End Sub

Tak for de to bud. Jeg benyttede løsningen fra jonesw igår, men fik ikke lige lukket tråden, så der er points til jonew!

Mange tak for points...

Og må sige at det også er et fint bud at oyejo kommer med...

Ja der er intet galt med buddet fra oyejo, problemet er bare at der er tale om et dashbord hvor top 10 kunder skal sættes ind i en specifikt område, og jeg kan derfor ikke bare slette resten, men kunne selvfølgelig bare sætte alle tal ind et helt andet sted først og derefter tage de 10 øverste og flytte over på mit dashboard.....så nu fortyder jeg da egentligt at jeg ikke gav points til jer begge, men det er jo for sent nu og håber at oyejo overlever ;-) men igen mange tak til jer begge to