Automatisk fordel data på ark2 og ark3

Kunne en makro være en mulighed?

ja det kunne være lige så fint som en almindelig formel.

Rem Koden indsættes under Ark1 /højreklik / Vis programkode
Rem Koden kan aktiveres fra Ark1 / Alt+F8 / fordelPåArk / Afspil
Rem Evt. forbindes med en knap

Dim antalRæk As Long
Dim a1 As Worksheet, ræk1 As Long
Dim a2 As Worksheet, ræk2 As Long
Dim a3 As Worksheet, ræk3 As Long
Public Sub fordelPåArk()
    Set a1 = ActiveWorkbook.Sheets("Ark1")
    Set a2 = ActiveWorkbook.Sheets("Ark2")
    Set a3 = ActiveWorkbook.Sheets("Ark3")

Rem Antal rækker på ark1
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Rækkenr til ark2 / 3
    ræk2 = 1
    ræk3 = 1

    Application.ScreenUpdating = False
   
    For ræk1 = 1 To antalRæk
        Rows(ræk1).Select
        Selection.Copy
       
        If Range("A" & ræk1) = 21 Then
            a2.Select
            ActiveSheet.Rows(CStr(ræk2)).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            ræk2 = ræk2 + 1
        Else
            a3.Select
            ActiveSheet.Rows(CStr(ræk3)).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            ræk3 = ræk3 + 1
        End If
       
        a1.Select
        Application.CutCopyMode = False
    Next ræk1
   
    Application.ScreenUpdating = True
   
    MsgBox "Fordeling udført"
End Sub

Hold op hvor det virker :)

Mange tak for hjælpen! Kast et svar

hov, så ikke du havde lavet det som et svar.
Men endnu en gang tak for hjælpen!

Ok - selv tak

Lige et kort tillægsspørgsmål, som jeg håber du kan svare på. hvis der i sorteringsarket bliver tilføjet endnu kategori, eksempelvis 23, hvordan får jeg denne sorteret ligesom 21 og 22?

Er 23 den eneste tilføjelse - kommer 24 også?

Hviskun 23 er det rimeligt enkelt - vender tilbage med koden - ellers en lidt anden situation - men også mulig.

Det kan desværre sagtens tænkes at 24 kommer på et tidspunkt :(

ok - ser lige på det..

Kunne du forestille dig, at arkene til fordeling på forhånd fik ændret navn til værdien?

Så vil det gøre alting lettere..

Mener du at arket hvor 22 bliver sorteret ud på hedder "22"? i såfald ville det ikke være noget problem.

Ja - det mener jeg - så når der kommer et nyt nummer - så opretter du blot et ark med dette nummer som navn..

Det ville faktisk være en rigtig fed feature :)

er på vej...

NB Arkene behøver ikke stå i rækkefølge. Er et ark ikke oprettet kommer deren melding og der fortsættes med næste ark.


Rem version 2
Rem =========
Rem Koden indsættes under Ark1 /højreklik / Vis programkode
Rem Koden kan aktiveres fra Ark1 / Alt+F8 / fordelPåArk / Afspil
Rem Evt. forbindes med en knap

Dim antalRæk As Long
Dim a1 As Worksheet, ræk1 As Long, arkNr As String
Dim ax As Worksheet, rækx As Long
Public Sub fordelPåArk()
    Set a1 = ActiveWorkbook.Sheets("Ark1")

Rem Antal rækker på ark1
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    Application.ScreenUpdating = False
   
    For ræk1 = 1 To antalRæk
        Rows(ræk1).Select
        Selection.Copy
       
Rem hent nr fra kolonne A
        arkNr = Range("A" & ræk1)

Rem aktiver det pågældende ark
On Error GoTo fejl

        Set ax = ActiveWorkbook.Sheets(arkNr)
        ax.Select
       
        If arkNr <> "" Then
            rækx = ActiveCell.SpecialCells(xlLastCell).Row
            If rækx = 1 And ax.Range("A1") <> "" Then
                rækx = rækx + 1
            End If
           
            ActiveSheet.Rows(CStr(rækx)).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
           
        End If
        a1.Select
        Application.CutCopyMode = False
    Next ræk1
   
    Application.ScreenUpdating = True
   
    MsgBox "Fordeling udført"
    Exit Sub
   
fejl:
    If arkNr <> "" Then
        MsgBox "Ark " & arkNr & " er ikke oprettet"
    End If
   
    Application.CutCopyMode = False
    arkNr = ""
    Resume Next
End Sub

Det spiller altså bare!

Endnu engang tusinde tak for hjælpen!

Fint - selv tak..

Jeg har med stor glæde prøvet at arbejde videre med dit forslag 2, hvor makroen tager højde for, at der kan komme x antal ark - i mit tilfælde årstal.

Jeg kan bare ikke få to ting til at fungere:

1) Hvordan får jeg data ind, så de starter på række 6 i de ark, de skal fordeles på?

2) Jeg har oprettet en dataforbindelse til en underliggende database, hvor brugeren løbende skal kunne opdatere data fra - så hvordan får jeg overskrevet de data, der er fordelt, når der sker en ny opdatering af data?

På forhånd tak for hjælpen

Jeg tror du skal oprette et nyt spørgsmål - det er jo trods alt 1½ år siden - kniber med tiden..

Nej - > 2½ år

Gør jeg :-)