Sortering i ark

øv håber nogen kan tyde den.. den ser noget rod ud den opstilling.. :O(

Lige et tillægsspørgsmål...
Jeg overvejede at lave dette i en form hvor den tæller nuværende antal Ark og spørger hvilke ark jeg vil have makroen til at køre på...
Sådan at den tæller nuværende antal ark og jeg markerer hvilke ark og trykker på "kør" eller lign.

Er dette muligt?

Prøv at køre denne makro, når du står på hovedarket.
Bemærk at den ikke flytter data, den kopier den over, dvs. at de ikke forsvinder fra hovedarket

Option Base 1
Option Explicit

Sub AutoFilterModel()
'Created by Tommy bak Christensen 20-8-2002

Dim Uniq_Matrix As New Collection
Dim TempMatrix, Item
Dim StartSheet As Worksheet
Dim rngStart As Range, rngIndexCol As Range
Dim i As Long, lLC As Long
Dim iCounter As Integer, iUniqTotal As Integer, iFilterCol As Integer
Dim SH As Worksheet
  Set StartSheet = ActiveSheet
  With Application
      .DisplayStatusBar = True
      Set rngStart = StartSheet.Range("A1")
      Set rngIndexCol = StartSheet.Range("B1")
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
  End With
  '***fyld alle data i kol A over i et midlertidig array
  With rngIndexCol
      TempMatrix = Range(Cells(rngStart.Row, .Column), Cells(65536, .Column).End(xlUp).Address)
      iFilterCol = .Column - rngStart.Column + 1
  End With
  '***træk de unikke items ud i en collection
  On Error Resume Next
  For i = 2 To UBound(TempMatrix)
      Uniq_Matrix.Add TempMatrix(i, 1), CStr(TempMatrix(i, 1))
  Next i
  '***Frigør TempMatrix
  Set TempMatrix = Nothing
  iUniqTotal = Uniq_Matrix.Count
  '***med alle unikke items, autofilter og kopier til nyt ark
  For Each Item In Uniq_Matrix
      With rngStart.Cells(1, 1)
        .AutoFilter Field:=iFilterCol, Criteria1:=Item
        .CurrentRegion.Copy
      End With
      Set SH = Worksheets.Add
      SH.Name = Item
      SH.Range("A1").PasteSpecial (xlPasteValues)
      'find sidste celle
      lLC = SH.Range("A1").End(xlDown).Row + 1
      ' indsæt summer og farv samt linier
      SH.Range("C" & lLC).Formula = "=SUM(C2:C" & lLC - 1 & ")"
      SH.Range("C" & lLC).Copy SH.Range("C" & lLC).Offset(0, 1)
      With SH.Range("C" & lLC & ":D" & lLC)
        .Interior.ColorIndex = 3
        .Interior.Pattern = xlSolid
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).LineStyle = xlDouble
        .Borders(xlEdgeBottom).Weight = xlThick
      End With

      iCounter = iCounter + 1
      Application.StatusBar = iCounter & "  af  " & iUniqTotal & " kopieret"
  Next

  rngStart.AutoFilter
  With Application
      .CutCopyMode = False
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
      .StatusBar = False
  End With
  Set Uniq_Matrix = Nothing
End Sub

Hej Bak
Tak for dit svar.. men det er ikke autofilter funktionen jeg er ude efter, men at den kan oprette og døbe et ark for hvert nummer hvor den flytter alle data til  dette ark... :O/

Det er jo netop det makroen gør.....

Hov ja det kan jeg godt se nu.
Det er fordi at på den jeg tester af har jeg 2 ark.. på det første ark er der mange numre nedaf, og her opretter den ikke noget ark, den laver blot autofilter funktionen.
På ark 2 står der kun 1 nummer nedaf, og her sætter den ikke autofilter på, men opretter et nyt ark og flytter disse data over med sum nederst.

Hvorfor gør den ikke det med det ark der er fyldt helt ud ned til række 65536?

Jeg forsøgte lige at fjerne de nederste linier, og så virker den rigtigt.
Hvordan kan det egenligt være.. at hvis arket er fyldt helt ud.. så vil den ikke, men da jeg fjernede 5 linier så kørte den efter hensigten.

Kan jeg mens disse ark bliver oprettet, få makroen til at omdøbe hvert ark til det nummer de indeholder?

Du skal lige ændre denne linie
Set rngIndexCol = StartSheet.Range("B1")

til

Set rngIndexCol = StartSheet.Range("A1")

se eks
www.tbdl.dk/excel/tlfnr.xls

Ja se der var noget af det rigtige...

men nu har jeg kopieret koden ind i det ark jeg prøver af på.
På ark1, er der 65536 incl overskriften udfyldt, så tager den kun og laver Autofilter funktionen, og stopper her uden at melde fejl og uden at kopiere til nye ark.
Rydder jeg blot en linie i dette ark så vil den gerne?

Er der en kode man kan lægge ind så at den sletter de oprindelige ark der ligger.
Endvidere, kan den Tælle nuværende antal ark og spørge om hvilke ark denne makro skal køres på, eller at den blot kører alle ark igennem fra start når man trykker på knappen?

Prøv lige at ændre denne linie
TempMatrix = Range(Cells(rngStart.Row, .Column), Cells(65536, Column).End(xlUp).Address)

til
TempMatrix = Range(Cells(rngStart.Row, .Column),Cells(1, Column).End(xlDown).Address)

Hvis det man sortere på er i kolonne K, hvor skal man så ændre i koden?

Set rngIndexCol = StartSheet.Range("B1")
ændres til
Set rngIndexCol = StartSheet.Range("K1")

Hej Bak
Denne er godt nok gammel men du skal have dine point, så gider du lige smide et svar så jeg kan lukke den

ok :-)