[Løst] Makro stopper

[Trelkrok]

Spilt inn hjemme på Office 365 og fungerer fint.

På jobb har de Office 2010 og der stopper makroen (se gult felt)

Begge versjoner er Norsk.

 

Kan ellers nevene at det er mange sammenslåtte celler men disse er tilbakestilt for så og bli sammenslått igjen etter sortering.

 

Noen som har løsning på dette?

 

Utdrag fra Makroen under.

 

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Add2 Key:=Range( _

        "AD13:AD26"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort

 

 

Forøvrig er hele makroen her: (har nå kortet den ned og fungerer fint på Office 365), gul/orange skrift viser hvor makroen stopper i Office 2010

 

Sub Sortere()

'

' Sortere Makro

'

 

'

    Application.ScreenUpdating = False 'skjule hva som skjer

Application.Calculation = xlCalculationManual 'Excel regner ikke ut

    ActiveSheet.Unprotect Password:="****"

 

    Range("S1:AD1,K3:U3,V3:AD3,F5:AD5,B13:G26").Select

    Range("B13").Activate

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

  

   

    Selection.UnMerge

    Range("B13:AD26").Select

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Add2 Key:=Range( _

        "AD13:AD26"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort

        .SetRange Range("B13:AD26")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

   

    Range("S1:AD1,K3:U3,V3:AD3,F5:AD5,B13:G13").Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.Merge

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

   

    Range("K3:U3").Select

        Selection.Merge

    With Selection

        .HorizontalAlignment = xlRight

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

  

   Range("V3:AD3").Select

        Selection.Merge

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

   

    Range("F5:AD5").Select

        Selection.Merge

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlTop

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

   

    Range("B13:G13").Select

        Selection.Merge

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

   

    Selection.Copy

    Range("B14:G26").Select

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False

    Range("S1:AD1").Select

   

        Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

    Application.ScreenUpdating = True 'viser hva som skjer igjen

DoEvents

Application.Calculate

DoEvents

    MsgBox "Hjelpeskjema er sortert i prioritert rekkefølge. Risikokartlegging/ handlingsplan kan nå gjennomføres. :)"

ActiveSheet.Protect Password:="****", _

      DrawingObjects:=True, Contents:=True, Scenarios:=True

 

End Sub

Endret 25. september 2018 av Trelkrok

[Harald Staff]

Hei

 

Jeg tror du i 365 / 2016 har støtt på ett eller flere elementer som er oppfunnet etter 2010-versjonen, uten at jeg helt kan peke på hva. Lurer på om SortFields eller DataOption kan være nye greier. Moralen er å alltid bygge i eldste versjon. Men det er ikke alltid så praktisk.

 

Her er en "gammeldags" sorteringsrutine som skal funke i praktisk talt alle versjoner. Den sorterer en liste med overskrifter i rad 1, sorteringsrekkefølge A, så B og så C. I gamle dager var det et tak på tre sorteringskriterier, så vi måtte først sortere 4,5,6 og så 1,2,3. Det var et slit kan du tro  Men det betyr altså at du ikke kan utvide koden med Key4, du må "forhåndssortere" slik jeg beskrev.

 

Se om du kan skrive denne om til ditt bruk:

Sub SimpleSort()
Dim oSht As Worksheet

Set oSht = ActiveWorkbook.Worksheets("1 Hjelpeskjema")

oSht.Range("A2").CurrentRegion.Sort Key1:=oSht.Range("A2"), _
    Order1:=xlAscending, _
    Key2:=oSht.Range("B2"), _
    Order2:=xlAscending, _
    Key3:=oSht.Range("C2"), _
    Order3:=xlAscending, _
    Header:=xlYes, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom

End Sub

Beste hilsen Harald

[Trelkrok]

Takk for svar    Skal teste ut denne. Kommer tilbake med tilbakemelding hvis jeg får det til 

 

Mvh

RA

[Trelkrok]

Da har jeg løst dette problemet     Ikke store forskjellen   

Setter denne som løst   

 

 

Denne fungerer i Office 365 men ikke i Office 2010

 

 ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Add2 Key:=Range( _

        "AD13:AD26"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort

 

 

Den under fungerer i Office 2010 og Office 365   

 

ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort.SortFields.Add Key:=Range( _

        "AD13:AD26"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("1 Hjelpeskjema").Sort