excel - valg af indhold

OK.

Navngiv området A2:A13 på Kategoriarket, som "Kategori"

marker A4 på indtast arket, vælg
Data> Datavalidering > Tillad: = Liste
i Kilde skal stå =Kategori

når det er gjort, lav så arkene Januar, Februar o. s. v.
Lav kolonneoverskrifter i dem

Højreklik på fanen til indtastnings arket, vælg vis programkode,. sæt denne kode derind. så skulle det virke.


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$4" Then
        Dim RW As Long, Navn As String
        Application.EnableEvents = False
        Select Case Month([A1])
        Case 1: Navn = "Januar"
        Case 2: Navn = "Februar"
        Case 3: Navn = "Marts"
        Case 4: Navn = "April"
        Case 5: Navn = "Maj"
        Case 6: Navn = "Juni"
        Case 7: Navn = "Juli"
        Case 8: Navn = "August"
        Case 9: Navn = "September"
        Case 10: Navn = "Oktober"
        Case 11: Navn = "November"
        Case 12: Navn = "December"
        End Select
        RW = Worksheets(Navn).Range("A65536").End(xlUp).Row + 1
        Range("A1:A4").Copy
        Worksheets(Navn).Cells(RW, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                                                False, Transpose:=True
        Range("A1:A4").ClearContents
        MsgBox " Data fltrret til arket " & Navn & " Række " & RW
        Application.EnableEvents = True
    End If
End Sub

Indsættes i modul for dit indtastningsark


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$2" Then
        With Worksheets("Januar")
            sidsteræk = .Range("A65536").End(xlUp).Row + 1
            Range("A2:D2").Copy .Range("A" & sidsteræk)
            .Columns("A:D").Sort Key1:=.Range("A1"), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        End With
    End If
End Sub

Som kabbak foreslår, med alle måneder, hvor der også sorteres.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$2" Then
    måneder = Array("Januar", "Februar", "Marts", "April", "Maj", _
    "Juni", "Juli", "August", "September", "Oktober", "November", "December")
    Måned = måneder(Month(Range("A2")) - 1)
        With Worksheets(Måned)
            sidsteræk = .Range("A65536").End(xlUp).Row + 1
            Range("A2:D2").Copy .Range("A" & sidsteræk)
            .Columns("A:D").Sort Key1:=.Range("A1"), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        End With
    End If
End Sub

vil i smide et svar hver, så er der lidt til hver af jer.
Beklager jeg ikke har fået lukket den endnu..

;-))