Organisere et regnark

Ja - men spørgsmål:

- er arkene 0,03 o.s.v. oprettet i forvejen?
- arket med rådata - hedder dette også "rådata"?
- er det hele rækken, der skal kopieres til det "respektive ark"?

a) arkene er ikke oprettede i forvejen, så ud fra typen skal disse oprettes
b) ja, arket har jeg valgt at kalde rådata
c) det er hele rækken der skal kopieres.

håber det kaster lidt lys over det :-)

Ja - har konstrueret et system for et stykke tid siden, der har en problematik, der ligner.

Kan du læse & anvende VBA?

hej

Ja, jeg kan godt læse VBA kode ;-)... og anvende det.

takker for du vil kigge på det.

Rem Koden anbringes "under" Rådata-ark
Rem ==================================
Const typeKolonne = "D"                            'Tilpasses
Dim råArk As Worksheet

Dim antalKolonner
Public Sub udførOrganisering()                      'Evt. forbind med knap
Dim typeNr, række

    Set råArk = ActiveWorkbook.Sheets("rådata")
    antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
   
    Application.ScreenUpdating = False
   
Rem traverser TYPE-kolonnen indtil blank
    For række = 2 To 65000
        Range(typeKolonne & CStr(række)).Select
       
        If Selection.Value <> "" Then
            typeNr = Selection.Value
Rem findes typeNr-fanen
            If findesTypeArk(typeNr) = False Then
                opretTypeArk typeNr
            End If
           
            indsætItypeArk række, typeNr
        Else
            Exit For
        End If
    Next række

    Application.ScreenUpdating = True
   
    MsgBox ("Gennemløb afsluttet")
End Sub
Private Function findesTypeArk(nr)
Dim ark
    For Each ark In ActiveWorkbook.Sheets
        If ark.Name = nr Then
            findesTypeArk = True
            Exit Function
        End If
    Next
   
    findesTypeArk = False
End Function
Private Sub opretTypeArk(nr)
    With ActiveWorkbook
        .Sheets.Add after:=Sheets(ActiveWorkbook.Sheets.Count)
        .Sheets(.Sheets.Count).Name = nr
    End With
End Sub
Private Sub indsætItypeArk(række, typeNr)
Dim ræk, sArk

    Set sArk = ActiveWorkbook.Sheets(typeNr)
    sArk.Activate

Rem find første tome række
    With sArk
        For r = 1 To 65000
            If .Range("A" + CStr(r)) = "" Then
                ræk = r
                Exit For
            End If
        Next r
                   
        For kol = 1 To antalKolonner
            .Cells(ræk, kol) = råArk.Cells(række, kol)
        Next kol
   
        .Columns.AutoFit
    End With
   
    råArk.Activate
End Sub

I givet fald kan hele filen sendes til dig - mail-adr. under min profil

Hvis "TypeNr" er numerisk:

        If Selection.Value <> "" Then
            typeNr = cstr(Selection.Value)  '<----------
Rem findes typeNr-fanen
            If findesTypeArk(typeNr) = False Then
                opretTypeArk typeNr
            End If

supermange tak for hjælpen.
:-)