Sub FlytMarkerede()
    Application.ScreenUpdating = False
    Dim c As Range
    'Slet alt på ark 2
    Worksheets(2).Cells.ClearContents
    
    'Flyt data
    For Each c In Range(Worksheets(1).Range("A2"), Worksheets(1).Range("A" & Worksheets(1).Rows.Count).End(xlUp)).Cells
        If LCase(c.Offset(0, 1).Text) = "x" Then
            c.Copy Destination:=Worksheets(2).Range("A" & Worksheets(2).Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next
    Worksheets(2).Range("A1").Value = "Navn"
    
    'Sortering
    With Worksheets(2)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
    End With
    Application.ScreenUpdating = True
End Sub