Indsætte/kopiere linie forsk. steder alt efter kode 1-5

Giver gerne flere point end de 60, men kan bare ikke umiddelbart finde ud af hvordan dette gøres. Kan nogen hjælpe mig tila til at smide lidt flere point "på bålet" ?

http://expfaq.dk/giv_flere_point#giv_flere_point

Kopier dine data til nyt ark inkl. overskrifter. Marker alle dataene i dit nye ark, vælg Data > subtotaler. Her kan du angive hvad den skal summere m.v.

Jep, det gav faktisk menig. mange tak for det.
Men så kommer næste problemstilling om hvordan man laver en overskrift og en ialt tekst (som man selv bestemmer) på hver enkelt subtotal.

Fks.  Omsætning
      Omsætning i alt

      Vareforbrug
      Vareforbrug i alt

Pt. er der ingen overskrifter + subtotal1 +subtotal2 osv.

Da sorteringen skal kunne laves efter hver gang man har ændret en gruppe kode fra feks. 1 til 2 er det vigtigt at jeg kan lave en formatering/makro som sørger for at layoutet altid er ens.

Prøv denne makro. Indsæt et nyt ark og kopier makroen ind og kør den.
Tilret rækkenr. for første række med data, og tilret arknavnet ("Ark2")


Sub kontoplan_ny()
Dim poster()
Dim I, J, K, L
startrække = 2 'tilrettes til første række med data ekskl. overskrift
With Worksheets("Ark2") 'tilrettes til ark med data
    slutrække = .Range("D65536").End(xlUp).Row
    kode = .Range("D" & startrække & ":D" & slutrække)
    data = .Range("A" & startrække & ":D" & slutrække + 1)
End With
overskrifter = Array("Omsætning", "Vareforbrug", _
"Administrationsomkostninger", "Afskrivninger", "Renter")
sidste = UBound(data)
ReDim poster(sidste * 3, 3)
L = 1
For I = 1 To sidste - 1
poster(K, 0) = overskrifter(I - 1)
K = K + 1
mindstekode = WorksheetFunction.Small(kode, L)
    For J = 1 To sidste
            If data(J, 4) = mindstekode Then
                poster(K, 0) = data(J, 1)
                poster(K, 1) = data(J, 2)
                poster(K, 2) = data(J, 3)
                totalkode = totalkode + data(J, 3)
                K = K + 1
                L = L + 1
            End If
    Next J
    poster(K, 0) = overskrifter(I - 1) & " I alt"
    poster(K, 2) = totalkode
    K = K + 2
    totalkode = 0
    If L = sidste Then Exit For
Next I
Range("A2").Resize(UBound(poster), 3) = poster
End Sub

Jeg kan dælme ikke få det til at virke. Måske fordi jeg ikke helt forstår programmeringssproget.

Jeg får en fejlmeddelelese "Runtime 13"

Fejlen opstår i denne linie:
totalkode = totalkode + data(J, 3)

Såvidt jeg kan forstå så skal mine "koder" 1 eller 2 eller 3 osv. stå i kolonne "J"
Men hvad med kontonavn, beløb i år, beløb sidste år. Skal de stå i bestemte kolonner eller er det underordnet.

På forhånd tak

Ps. jeg skal nok få tildelt flere point til dette svar :-)

Mvh.

Kim

Makroen er udelukkende lavet ud for det skitserede i dit spørgsmål.
Dn løber dataene igennem i området A2:D "sidste række".
Dine koder står derfor i kol. D og J er bare en tæller.
Makroen skal sikkert tilrettes dine data, så hvis du angiver dit område, kan jeg prøve at rette det.

Nu har jeg prøvet at lave ark 2 fuldstændig som i mit ekempel ovenfor, men mit rengeark sletter bare nogle liner.


Mine data står i området a2:

Kolonne:
a  reserveret til en scesifikationsnr.
b  tekst/kontonavn
c  beløb iår
d  tomt
e  beløb sidste år
f  tomt
g  kontonr.
h  KODE!!!!

Altså a2:h9999

OBS!!!
Jeg kan se at de forskellige overskrifter kommer fra selve koden "omsætning, vareforbrug m.m.
Kan det lade sig gøre at hente disse overskrifter fra en simepel liste lavet i et frit ark. For eks.
1 Omsætning  (Omsætning bliver derved sammenkædet med 1)
2 Vareforbrug  (vareforbrug sammenkædes med 2 osv)
3 Administrationsomkostninger
4 Renter
osv...

Nu har jeg fået det til at virke....men....
Min "formatering" af overskrifter og sum kontiene mangler. Disse skal vist gøres hver gang man har kørt makroen.

Kan man ikke lave følgende løsning?

Et tom ark med følgende linier:
Omsætning (kode 1)
Omsætning ialt (som summere alle linier mellem overskrift og ialt lininen)

Vareforbrug (kode 2)
Vareforbrug ialt

Administrationsomkostninger (kode 3)
Administrationsomkostninger ialt

Renter (kode 4)
Renter ialt

Arket med ovenstående data skal herefter hente data fra mit dataark og indsætte de forskellige linier i de forskellige grupper alt efter hvilken kode de har fået (1,2,3,4)?

Er lige kommet hjem fra 007 i biffen. prøver at nå at se på det i løbet af imorgen

Super, skal selv ind og se den inden længe.
Glæder mig til at se Mads M. som skurk

Lige et par spørgsmål.
Skal dataene hentes for A:H som du skriver, og vil du have alle dataene med over, eller kun nogle af kolonnerne ? Skal der laves et ark til koder og overskrifter som du nævner ?

Har tilrettet makroen til data i A:H
Yderligere tilføjet et tomt ark med overskrifter. Kode i A1:A5 og overskrifter i B1:B5.
Pt. hentes alle data over med subtotaler i beløb i år og beløb sidste år.
Indsæt og kør makroen i et nyt tomt ark.


Sub kontoplan_ny()
Dim poster()
Dim I, J, K, L
With Worksheets("Ark5") 'tilrettes til ark med data
    data = .Range("A2:H" & .Range("B65536").End(xlUp).Row + 1)
End With
With Worksheets("Ark6") 'tilrettes til ark med overskrifter
    overskrifter = .Range("A1:B" & .Range("B65536").End(xlUp).Row)
End With
sidste = UBound(data)
ReDim poster(sidste * 3, 7)
For I = 1 To UBound(overskrifter)
poster(K, 1) = overskrifter(I, 2)
K = K + 1
    For J = 1 To sidste
            If data(J, 8) = overskrifter(I, 1) Then
                poster(K, 0) = data(J, 1) 'reserveret til en scesifikationsnr.
                poster(K, 1) = data(J, 2) 'tekst/kontonavn
                poster(K, 2) = data(J, 3) 'beløb i år
                poster(K, 3) = data(J, 4) 'tomt
                poster(K, 4) = data(J, 5) 'beløb sidste år
                poster(K, 5) = data(J, 6) 'tomt
                poster(K, 6) = data(J, 7) 'kontonr.
                poster(K, 7) = data(J, 8) 'kode
                totaliår = totaliår + data(J, 3)
                totalsidsteår = totalsidsteår + data(J, 5)
                K = K + 1
            End If
    Next J
    poster(K, 1) = overskrifter(I, 2) & " I alt"
    poster(K, 2) = totaliår
    poster(K, 4) = totalsidsteår
    K = K + 2
    totaliår = 0: totalsidsteår = 0
Next I
Range("A2").Resize(UBound(poster), 8) = poster
End Sub

Det er prøvet og det virker super fint....men.... :-)

Jeg mangler at kunne formatere overskrifterne og sammentælingerne (eks, fed og str. 14)

Da eks. "omsætning ialt" TYPISK/NÆSTEN ALTID skal henvise til en specifik kolonne i et andet ark ville det være rart hvis overskrifterne og sammentællingen ALTID stod i det tomme ark. Når makroen så køres skal de enkelte linier med kode 1, 2, 3 så "Skubbes" ind mellem overskrifterne og sammentællingerne.
Derefter kan jeg jo så let som ingen ting hente omsætning ialt, vareforbrug ialt osv. til mit opsamlingsark.
Derved er mit problem med formatering også ude af verden da overskrifterne og sammentællingerne aldrig forsvinder fra selve arket.

Håber ikke at jeg bliver for vrøvlet. Det du har lavet indtil nu er super, men mangler lige det sidste.

Den med at "putte det ind" imellem overskrifter, bliver nok lidt vanskelig. Ihvertfald kræver det en ny makrokode.
Hvad med om vi istedet puttede formateringen ind i makroen, så den bare bliver genskabt påny hver gang makroen køres ?

Det er fint at formateringen kommer ind i makroen...men...
Jeg kan ikke rigtigt overskue hvordan jeg får flyttet omsætning ialt, vareforbrug ialt om i mit samleark, da ialt-linierne ender et nyt sted hver gang.

Men dette kan vel gøres hvis man laver et l-opslag på forsiden..... Og dog da jeg nogle gange skal bruge en netto-sammentælling (omsætning-vareforbrug=bruttoresultat) i mine specifikationer medens jeg andre gange ikke skal bruge denne sammentælling

(Det var derfor jeg nævnte det med at putte linierne ind mellem disse overskrift og sum, da jeg derved meget let kan bestemme om sammentællingen skal være der eller ej.

Jeg tror et lopslag kan klare det du søger. Men selvom man lavede en "skabelon" med ovrskrifter er du ikke garanteret at linjerne forbliver der. Hvad nu hvis der kommer nye konti til, eller konti slettes ??

Jeg har nu tilrettet makroen med formatering.


Sub kontoplan_ny()
Dim poster()
Dim I, J, K
With Range("A2:H65536")
    .ClearContents
    .Font.Bold = False
    .Borders.LineStyle = xlNone
    .Interior.ColorIndex = xlNone
End With
With Worksheets("Ark5") 'tilrettes til ark med data
    data = .Range("A2:H" & .Range("B65536").End(xlUp).Row + 1)
End With
With Worksheets("Ark6") 'tilrettes til ark med overskrifter
    overskrifter = .Range("A1:B" & .Range("B65536").End(xlUp).Row)
End With
sidste = UBound(data)
ReDim poster(sidste * 3, 7)
For I = 1 To UBound(overskrifter)
poster(K, 1) = overskrifter(I, 2)
K = K + 1
    For J = 1 To sidste
            If data(J, 8) = overskrifter(I, 1) Then
                poster(K, 0) = data(J, 1) 'reserveret til en scesifikationsnr.
                poster(K, 1) = data(J, 2) 'tekst/kontonavn
                poster(K, 2) = data(J, 3) 'beløb i år
                poster(K, 3) = data(J, 4) 'tomt
                poster(K, 4) = data(J, 5) 'beløb sidste år
                poster(K, 5) = data(J, 6) 'tomt
                poster(K, 6) = data(J, 7) 'kontonr.
                poster(K, 7) = data(J, 8) 'kode
                totaliår = totaliår + data(J, 3)
                totalsidsteår = totalsidsteår + data(J, 5)
                K = K + 1
            End If
    Next J
    poster(K, 1) = overskrifter(I, 2) & " I alt"
    poster(K, 2) = totaliår
    poster(K, 4) = totalsidsteår
    K = K + 2
    totaliår = 0: totalsidsteår = 0
Next I
Range("A2").Resize(UBound(poster), 8) = poster
For Each rng In Range("B2:B" & Range("B65536").End(xlUp).Row)
    If rng.Offset(-1, 0).Value = "" Or Right(rng.Value, 5) = "I alt" Then
    With rng.Resize(1, 7)
    .Font.Bold = True
    .Interior.ColorIndex = 15
    With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            End With
    End With
    End If
Next rng
End Sub

jeg har i min kontoplan oprettet ALLE nr. fra 1000-6999 for at sikre mig at der aldrig oprettes eller slettes linier. Jeg har lavet en makro der skjuler linier som ikke indeholder beløb. Jeg kører denne makro efter sorteringen er sket.
Derefter står specifikationerne "flot"

Har du testet det ?

prøver lige det samme. Sorry :-)

Det virker super.
Du har længe gjort dig fortjent til pointene.

men jeg har stadig problemer med mellemregninger i min spec. og derfor referencer til mit samleark.

Derfor er jeg nødt til at spørge om du kan hjælpe mig med en makro til at "putte" linierne ind mellem overskrifter og sumkonti.

Jeg vil give hvad som helst for at få det til at virke. Det gør nemlig den helt store forskel for mit lille regnskabssystem at dette kan gøres.

Mvh.

Kim

Jeg må indrømme at jeg ikke er helt klar over hvad du vil have mig til. Hvorfor vil du stadig have puttet linjer ind mellem overskrifter ?. Jeg troede at makroen netop erstattede dette. Prøv lige at forklare lidt om dit lille regnskabssystem, og sammenhængen mellem data, kontoplan m.v.

Hvis du ønsker at "Hive" tal ud af din nye kontoplan med overskrifter, er der noget som sandsynligvis kan klares med alm. formler. Så må du sige til, så klarer vi også den :-)

Jeg ved at godt at det er lidt kringlet, men jeg prøver lige om jeg kan illustrere mit problem:

jeg har en stor kontoplan fra 1000-6999 (voldsom mange konti)
Når jeg tildeler koderne  eks. 1-5 som vi har gjort indtil nu kan jeg gruppere konti som følger:

1000 Omsætning 1
1100 Omsætning 2
3600 Refusion af administrationsomkostninger
4500 Renteindtægter
SUM=Indtægter ialt (evt. kode 1)

1300 Vareforbrug
3601 Kontorartikler
4501 Renteudgifter
sum=udgifter 1 ialt (evt. kode 2)

1400 Fremmed arbejde
4200 Ejendomsskatter
4508 Låneomkostninger
sum=udgifter 2 ialt (evt. kode 3)

Som du kan se så vil jeg meget gerne have mulighed for at "blande" mine kontonr. vilkårligt.
Dette skyldes at beløbene står bogført på forskellige konti i bogføringsprogrammet. Hvis jeg ikke kan tildele koder til de enkelte konti er jeg nødt til hvert år at flytte rundt på mange konti når jeg laver regnskabet.

Den løsning du har lavet for mig er næsten det jeg søger, men der er lige den hurdle at:

Min resultatopgørelse/samleark ikke må ændre sig i udseende. Der er nogle helt specielle linier der skal stå i denne (lovkrav). Uanset hvilket firma jeg laver regnskab på.

Mine specifikationer derimod må gerne være forskellige alt efter hvilket firma det drejer sig om. Dette sker tit og ofte.

Derfor kan specifikationerne i en virksomhed have mellemudregninger,som Dækningsbidrag eller bruttoresultat eller noget helt andet.

Med den løsning vi har indtil nu, så sorterer makroen dataene som den skal. Men da den danner overskrifter/sumkonti hver gang man kører makroen er det "bøvlet" at lave evt. mellemresultater i specifikationerne og derefter referere til min forside/resultatopgørelse. (evt. mellemudregninger som forsvinder hver gang der dannes nye specifikationer og så ryger noget at automatikken)

Hvis vi nu siger at alle sumkontiene og mine mellemregninger allerede står i det "tomme" ark vil sammentællingerne være meget lettere at ændre reference til forsiden. Når denne ændring er foretaget EN gang på kunden vil sammentælling/resultatopgørelse altid være OK, uanset om  jeg flytter mine konti rundt imellem de enkelte "kodenr."

Som det er nu forsvinder mellemregninger hver gang der laves en ny sortering.



JEg ved ikke om du fattede en lyd af hvad jeg mener, men ellers må du lige give lyd.

Ok, men det korte af det lange er at du vil have en makro der gør næsten det samme, bare med den forskel at overskrifter og subtotaler er indsat i et tomt ark, og at kontiene til de enkelte hovedgrupper så skal puttes ind under den rigtige afhængig af koden. Korrekt ?
I så fald skal jeg vide hvilken celle "Omsætning, omsætning i alt, vareforbrug" m.v. står i, for at kunne angive dette i makroen.
Jeg går ud fra at vi stadig har endnu et tomt ark, hvor du så har defineret dine overskrifter/hovedgrupper, med de tilhørende koder, ligesom i den nyværende makro.

Jeg tror næsten ikke at vi kan løse denne, uden at have dokumentet. Send det evt. til alsikva snabela tiscali punktum dk.

den får du lige lidt senere, når jeg er kommet hjem :-)

Fil sendt retur

Og her er så koden det hele endte op med, som "putter" konti fra et ark over i et andet.


Sub specifikationer()
Dim poster()
Dim I, J, K

Application.ScreenUpdating = False
Worksheets("spec1").Activate

With Worksheets("Kontoplanen") 'tilrettes til ark med data
    data = .Range("A2:H" & .Range("B65536").End(xlUp).Row + 1)
End With

With Worksheets("overskrift") 'tilrettes til ark med overskrifter
    overskrifter = .Range("A2:B" & .Range("B65536").End(xlUp).Row)
End With

sidstedata = UBound(data)
rækkestart = 1

For I = 1 To UBound(overskrifter) 'Overskrifter løbes igennem
   
    For J = 1 To sidstedata 'antal poster = kriterier tælles op
        If data(J, 8) = overskrifter(I, 1) And _
        data(J, 3) + data(J, 5) <> 0 Then
            K = K + 1
        End If
    Next J
   
    If K > 0 Then
        ReDim poster(K - 1, 7)
        K = 0
   
        For J = 1 To sidstedata 'Kontoplan løbes igennem
            If data(J, 8) = overskrifter(I, 1) And _
            data(J, 3) + data(J, 5) <> 0 Then
            'poster(K, 0) = data(J, 1) 'tom
                poster(K, 1) = data(J, 2) 'tekst/kontonavn
                poster(K, 3) = data(J, 3) 'beløb i år
            'poster(K, 4) = data(J, 4) 'tomt
                poster(K, 5) = data(J, 5) 'beløb sidste år
                poster(K, 7) = data(J, 6) 'kontonr.
            'poster(K, 8) = data(J, 7) 'kontrolkode til specielle beregninger
            'poster(K, 9) = data(J, 8) 'kode
                K = K + 1
                totaliår = totaliår + data(J, 3)
                totalsidsteår = totalsidsteår + data(J, 5)
            End If
        Next J
    End If
   
    Range("B" & rækkestart).Select
    sidste = ActiveSheet.Range("B65536").End(xlUp).Row
   
    '<<<< Finder rækkenr. for overskrift >>>>
    Do
        ActiveCell.End(xlDown).Select
        If ActiveCell.Row > sidste Then Exit Do
    Loop Until ActiveCell.Value = overskrifter(I, 2)
    rækkestart = ActiveCell.Row
   
    '<<<< Finder rækkenr. for overskrift i alt >>>>
    Do
        ActiveCell.End(xlDown).Select
        If ActiveCell.Row > sidste Then Exit Do
    Loop Until ActiveCell.Value = overskrifter(I, 2) & " i alt"
    rækkeslut = ActiveCell.Row
   
    '<<<< Sletter rækker mellem overskrift og i alt >>>>
    If rækkeslut - rækkestart > 1 Then
        Rows(rækkestart + 1 & ":" & rækkeslut - 1).Delete
    End If
   
    '<<<< indsætter rækker og data og totaler mellem overskrift og i alt >>>>
    If K > 0 Then
        Rows(rækkestart + 1 & ":" & rækkestart + K).Insert shift:=xlShiftDown
        Range("A" & rækkestart + 1).Resize(K, 6) = poster
        Range("A" & rækkestart + 1).Resize(K, 6).Font.Bold = False
        Range("B" & rækkestart + 1).Resize(K, 1).NumberFormat = "@*."
        Cells(rækkestart + 1 + K, 4) = totaliår
        Cells(rækkestart + 1 + K, 6) = totalsidsteår
    Else
        Cells(rækkestart + 1 + K, 4) = 0
        Cells(rækkestart + 1 + K, 6) = 0
    End If
   
    '<<<< Nulstiller totaler og tæller inden næste overskrift hentes ind >>>>
    K = 0: totaliår = 0: totalsidsteår = 0
     
Next I

Range("A1").Select
Application.ScreenUpdating = True

End Sub

Hej jeg prøver at bruge ovenstående løsning men får en  "Run-time error 1004"
på linien      Cells(rækkestart + 1 + K, 4) = 1, jeg er total nybegynder, er der nogen som kan hjælpe mig hvor fejlen ligger

Har fået det til at virke men mangeler en grad total for alle koder?