rettelse i eksisterende kode

Jeg har en lang kode som virker næsten som den skal.
Men den har et mindre problem med at slå 2 linier sammen.

Jeg tror nok at jeg har lokaliseret problemet til at være i denne kode stump, men jeg kan ikke selv hitte ud af at ændre den

If Tjek(I, 1) = Tjek(Y, 2) Then
                        OK = True
                            If Tjek(I, 2) <> "" Then ' HVIS DER ER ANGIVET EN SAMLE KONTO SKAL DENNE BRUGES
                            Kontonr = Data(I, 1)
                            End If
                        Exit For

Jeg har en fil som jeg gerne sender. Det er lidt kompliceret at forklare helt kontrekt ud at kunne vise jer filen.

Jeg beklager den lave point givning, men dette er mine uigenkaldelige sidste point :-)










Sub Dan_regnskab_specifikation()
Dim Data As Variant, I As Integer, X As Integer, SumPoster As Variant, ErDerSumposter As Boolean, RK As Integer
    Dim NR As Integer, Antal() As Variant, T As Integer, N As Integer, RækkeStart As Integer, OV As Variant, Tid As Date
    Dim MinRækker As Integer

    ActiveSheet.PageSetup.PrintArea = ""
    'Tid = Now
    ErDerSumposter = False
    RK = 0
    Application.Calculation = xlCalculationManual    ' stopper automatisk udregning af formler
    Application.ScreenUpdating = False
    With Worksheets("Konto")
        MinRækker = .Range("G1")    ' Minimum rækker incl overskrift og total
        ' Tjekker om der valgt overskrifter, det skal være det samme i N og O kolonnen
        Data = .Range("A5:P" & .Range("B65536").End(xlUp).Row + 50)  ' indlæser kontoplan i variablen Data + 50 tomme rækker

        Tjek = .Range("N5:O" & .Range("B65536").End(xlUp).Row)
        .Range("C200").End(xlUp).Value = WorksheetFunction.Sum(.Range("C1:C200")) * -1
        .Range("E200").End(xlUp).Value = WorksheetFunction.Sum(.Range("E1:E200")) * -1
        With Worksheets("overskrift")    'tilrettes til ark med overskrifter
            Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row)
        End With
        SidsteData = UBound(Data)
        For I = 1 To UBound(Tjek)
            OK = False
            For Y = 1 To UBound(Tjek)
                If Not IsEmpty(Tjek(I, 1)) Then
                    If Tjek(I, 1) = Tjek(Y, 2) Then
                        OK = True
                            If Tjek(I, 2) <> "" Then ' HVIS DER ER ANGIVET EN SAMLE KONTO SKAL DENNE BRUGES
                            Kontonr = Data(I, 1)
                            End If
                        Exit For
                    End If
                Else
                    OK = True
                End If
            Next
            If Not OK Then
                Application.ScreenUpdating = True
                Application.Calculation = xlCalculationManual    ' starter automatisk udregning af formler
                MsgBox "Du har glemt at angive nr i kolonne O i linien(" & .Range("O" & I + 4).Offset(0, -14) & " " & .Range("O" & I + 4).Offset(0, -13) & ")"

                Exit Sub
            End If
        Next


    End With
    ' kolonner i variablen Data
    ' Tekst, importeret fra regnskabssystem '  i år  '  x '  sidste år '  x  ' specnr. I år  '  Overskrift ' * '  specnr. sidste år
    '  1                  2                  3        4        5      6        7              8        9          10
    '  Overskrift ' * '  x ' Liner som skal samles'  Hvilken TEKST / NAVN skal vises' Alt:Titel
    '    11      12  13          14                      15                            16
    With Worksheets("overskrift")    'tilrettes til ark med overskrifter
        Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row)
    End With

    K1 = 0    ' nulstiller antal samledata
    For I = 1 To UBound(Data)
        If IsEmpty(Data(I, 7)) And IsEmpty(Data(I, 10)) Then
            If RK = 0 Then RK = I    ' første række der er ledig i Variablen Data
            For X = 1 To UBound(Data, 2)
                Data(I, X) = Empty    ' sletter data der ikke har et specnr
            Next
        Else
            Data(I, 3) = Data(I, 3) * Data(I, 9)    ' ganger beløbet

            If IsEmpty(Data(I, 10)) Then    ' hvis faktor for sidste år er tom, bruges dette år
                Data(I, 5) = Data(I, 5) * Data(I, 9)    ' ganger beløbet Sidste år med faktor i år
            Else
                Data(I, 5) = Data(I, 5) * Data(I, 12)    ' ganger beløbet Sidste år med faktor Sidste år
            End If
        End If
    Next

    '**************************************************** slut med at tælle sumposter og gange med faktor ***********************

    '******************************************************* Begynder at dele konti på specnr per år ***********************************

    SidsteData = RK - 1
    NR = RK
    For I = 1 To SidsteData
        If Not IsEmpty(Data(I, 7)) And Not IsEmpty(Data(I, 10)) Then
            For X = 1 To UBound(Data, 2)
                Data(NR, X) = Data(I, X)
            Next
            Data(NR, 3) = 0
            Data(I, 5) = 0
            Data(NR, 7) = Data(I, 10) * 100
            If Not IsEmpty(Data(I, 15)) Then Data(NR, 15) = Data(I, 15) * 100    '  specnr* 100, på dem der skal adskilles, for sidste år

            Data(NR, 14) = Data(I, 14) * 100    '  specnr* 100, på dem der skal adskilles, for sidste år

            NR = NR + 1
        End If
        If Not IsEmpty(Data(I, 16)) Then Data(I, 2) = Data(I, 16) & " "
    Next
    Sheets.Add
    ActiveSheet.Name = "TEMP"    ' bruger et midlertidig ark til sortering
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _
                , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                  False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
                                                                              :=xlSortNormal
    Data = Range("A1").Resize(NR + 50, UBound(Data, 2))
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    SidsteData = NR
    '******************************************************* Færdig med at dele konti på specnr per år ***********************************

    '******************************************************* Begynder at summere, dem der skal ***********************************
    For I = 1 To SidsteData

        If Not IsEmpty(Data(I, 15)) Then
            K1 = K1 + 1    ' tæller antal samledata
            ReDim Preserve Antal(K1)
            Antal(K1) = Data(I, 15)
            ErDerSumposter = True
        End If
    Next
    ' kolonner i variablen Data
    ' Tekst, importeret fra regnskabssystem '  i år  '  x '  sidste år '  x  ' specnr. I år  '  Overskrift ' * '  specnr. sidste år
    '  1                  2                  3        4        5      6        7              8        9          10
    '  Overskrift ' * '  x ' Liner som skal samles'  Hvilken TEKST / NAVN skal vises' Alt:Titel
    '    11      12  13          14                      15                            16
    If ErDerSumposter Then
        For X = 1 To UBound(Antal)
            For I = 1 To SidsteData
                If Antal(X) = Data(I, 14) Then    ' passer sammentællingskoden, så fortsæt
                    If Not IsEmpty(Data(I, 16)) Then    ' er der special overskrift
                        Data(NR + X, 2) = Data(I, 16) & " "    ' special Overskrift
                    ElseIf Not IsEmpty(Data(I, 15)) Then    ' eller er der et tal ud for en anden
                        Data(NR + X, 2) = Data(I, 2)      ' normal Overskrift
                    End If
                    Data(NR + X, 1) = Kontonr 'HVIS DER ER EN SAMLEKONTO SKAL DEN BRUGES
                    Data(NR + X, 3) = Data(NR + X, 3) + Data(I, 3)    ' summere dette år
                    Data(NR + X, 5) = Data(NR + X, 5) + Data(I, 5)    ' summere sidste år
                    Data(NR + X, 7) = Data(I, 7)    ' specnr
                    For T = 1 To UBound(Data, 2)
                        Data(I, T) = Empty    ' sletter data efter summering
                    Next
                End If
            Next
        Next
    End If

    For X = 1 To UBound(Data)
        If Data(X, 7) > 100 Then Data(X, 7) = Data(X, 7) / 100        ' Retter specnr, på dem der skal adskilles, for sidste år
    Next
    Sheets.Add    ' bruger et midlertidig ark til sortering
    ActiveSheet.Name = "TEMP1"
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _
                , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                  False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
                                                                              :=xlSortNormal
    Application.DisplayAlerts = False
    Data = Range("A1:G" & Range("B65536").End(xlUp).Row)
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    '******************************************************* summerering slut ***********************************

    Worksheets("spec1").Activate
    With Worksheets("spec1")
        Cells.Rows.Hidden = False
        ActiveSheet.DisplayPageBreaks = True
        For I = 2 To .Range("B1000").End(xlUp).Row
        Rows(I).PageBreak = xlPageBreakNone    ' fjerner sideskift
'          Rows(I).PageBreak = xlNone
          Next
        ActiveSheet.DisplayPageBreaks = False
        ' *********************************************Rettet gammel kode ********************************


        SidsteData = UBound(Data)
        RækkeStart = 4
        Application.ScreenUpdating = False

        For I = 1 To UBound(Overskrifter)    'Overskrifter løbes igennem

            For J = 1 To SidsteData    'antal poster = kriterier tælles op

                If Data(J, 7) = Overskrifter(I, 1) Then

                    If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then
                        K = K + 1
                    End If
                End If
                '
                '                If Data(J, 7) > Overskrifter(I, 1) Then Exit For
            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, 7) > Overskrifter(I, 1) Then Exit For
                    If Data(J, 7) = Overskrifter(I, 1) Then

                        If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then
                            Poster(K, 1) = Data(J, 2)    'tekst/kontonavn
                            Poster(K, 3) = Data(J, 3)    'beløb i år
                            Poster(K, 5) = Data(J, 5)    'beløb sidste år
                            Poster(K, 7) = Data(J, 1)    'kontonr.
                            K = K + 1
                            totaliår = totaliår + Data(J, 3)
                            totalsidsteår = totalsidsteår + Data(J, 5)

                        End If
                    End If
                Next J
                '**************************************** KABBAK *************************************************
            End If
            OV = Worksheets("spec1").Range("B6:B" & Worksheets("spec1").Range("B1000").End(xlUp).Row)
            For Y = UBound(OV) To 1 Step -1
                If OV(Y, 1) = Overskrifter(I, 2) And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then
                    RækkeStart = Y + 5    '<<<< Finder rækkenr. for overskrift >>>>
                    Exit For
                End If
                If OV(Y, 1) = Overskrifter(I, 2) & " i alt " And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then Rækkeslut = Y + 5  '<<<< Finder rækkenr. for overskrift i alt >>>>
            Next

            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
                With Range("B" & RækkeStart + 1).Resize(K + 1, 1)
                    .NumberFormat = "@*."
                    .HorizontalAlignment = xlDistributed
                End With
                .Cells(RækkeStart + 1 + K, 4) = totaliår
                .Cells(RækkeStart + 1 + K, 6) = totalsidsteår
                If UCase(Overskrifter(I, 3)) = "NEJ" Then
                    .Rows(RækkeStart - 1 & ":" & RækkeStart + K + 2).Hidden = True

                End If
                'Den må altså ikke skjule grupperne 1-13 og 69-74, da
                Select Case Overskrifter(I, 1)
                Case 1 To 13, 69 To 74
                Case Else
                    If K + 2 <= MinRækker + 2 Then
                        .Rows(RækkeStart - 1 & ":" & RækkeStart + K + 2).Hidden = True
                    End If
                End Select

            Else
                .Cells(RækkeStart + 1 + K, 4) = 0
                .Cells(RækkeStart + 1 + K, 6) = 0
                .Rows(RækkeStart - 1 & ":" & RækkeStart + 2).Hidden = True
            End If

            '<<<< Nulstiller totaler og tæller inden næste overskrift hentes ind >>>>
            K = 0: totaliår = 0: totalsidsteår = 0
            Application.StatusBar = "Danner SPECIFIKATION  " & I & " af " & UBound(Overskrifter)

        Next I

       
   
   
   
   
   
Calculate
Application.ScreenUpdating = False
        Application.StatusBar = ""
        ActiveSheet.DisplayPageBreaks = True
        Application.Calculation = xlCalculationAutomatic    ' Slår automatiske beregninger til igen
        Application.ScreenUpdating = True    ' slår opdatering af skærmen til igen
        .Range("F7").Select
    End With
  ' MsgBox Format(Now() - Tid, "nn:ss")    ' bare kommenter den ud, den viser tiden som koden tager for at køre.
   
    ActiveSheet.PageSetup.PrintArea = "$A:$F"
End Sub