Saldooplysning af konti pr. arkfane II

kan du sende et eksempel, så jeg kan se dine dataark.
Det skal vel forstås sådan, at det kun er de kontonumre der står ja udfor, der skal splittes op i selvstændige ark.

kabbak snabela email dot dk

Option Explicit

Public Sub FlytTilArk()
    Application.ScreenUpdating = False
    Dim Findes As Boolean, I As Long, WS As Worksheet, NewSheet As Worksheet, Sidenavn As String
    Dim T As Long, OK As Boolean, Kontoer As Variant, RW As Long
    RW = Worksheets("Stamdata").Range("A65536").End(xlUp).Row    ' NY
    Kontoer = Worksheets("Stamdata").Range("A2:B" & RW)    'NY
    For I = 2 To Worksheets("Data").Range("A65536").End(xlUp).Row
        Findes = False
        Sidenavn = Worksheets("Data").Cells(I, 1)
        For Each WS In Worksheets
            If WS.Name = Sidenavn Then
                Findes = True
                Exit For
            End If
        Next WS
        OK = False

        ' ****** Nyt afsnit
        For T = 1 To UBound(Kontoer)
            If Kontoer(T, 1) = Worksheets("Data").Cells(I, 1) And UCase(Kontoer(T, 2)) = "JA" Then
                OK = True
                Exit For
            End If
        Next
        If OK Then
            ' **** slut nyt afsnit

            If Findes Then
                Worksheets("Data").Rows(I).Copy Worksheets(Sidenavn).Range("A65536").End(xlUp).Offset(1, 0)
            Else
                Set NewSheet = Worksheets.Add
                NewSheet.Name = Sidenavn
                Worksheets("Data").Rows(1).Copy Worksheets(Sidenavn).Range("A1")    ' overskrifter på nye ark
                Worksheets("Data").Rows(I).Copy Worksheets(Sidenavn).Range("A65536").End(xlUp).Offset(1, 0)
                Set NewSheet = Nothing
            End If
        End If    ' NY
    Next
    Application.ScreenUpdating = True
End Sub

Sorry, gik tidligt i seng :o)

Og det virker squ :o) ... læg venligts et svar

et svar ;-))

Super god sagsbehandling fra din side

tak

Velbekommen ... din hjælp er uvurderlig

I går, nævnte jeg at jeg efterfølgende skulle have lavet en formattering af de enkelte saldolister/arkfaner, som gerne skulle foretages i samme øjemed. Der hvor du foreslog at formatteringskoden skulle indsættes dúr ikke, idet der sker det, at

Step 1 Overskriften indsættes
Step 2 Formatteringen foretages
Step 3 Data indsættes

Step 2 og 3 skal foretages i modsat rækkefølge

Kan koden indsættes et andet sted ?

Public Sub FormatteringAfArk()
    Dim WS As Worksheet
    For Each WS In Worksheets
        If WS.Name <> "Data" And WS.Name <> "Stamdata" Then
            WS.Select
           
            ' din formaterings kode

        End If
    Next WS
End Sub


Kald denne lige før

    Application.ScreenUpdating = True
End Sub

Takker endnu engang :o)