Fejl i makro

Har prøvet din funktion - ingen fejl - også 2007

Hvor optræder fejlen?
Vis evt variabler, der anvender funktionen.

Er faktisk ikke helt med på hvad den gør :-)

hvis MyDate ikke opfattes som en dato - så få den til det:

Function UgeNr(MyDate)
If IsDate(MyDate) Then
  UgeNr = DatePart("ww", MyDate, vbMonday, vbFirstFourDays)
Else
  UgeNr = DatePart("ww", CDate(MyDate), vbMonday, vbFirstFourDays)
End If
End Function

Jeg har prøvet at ændre programmet uden held.

Her er hele makroen:

Sub Diagram()
'Importer udtræk som det er!
Application.ScreenUpdating = False

'Åbner FilDialogÅben til at vælge fil
Sheets("Kontobevægelser").Activate
With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False

If .Show = -1 Then    'der er trykket OK
            navn = .SelectedItems(1)
           
        'Opsætter filen til import
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & navn, Destination:=Range("A1"))
        .Name = "Bevaegelser"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(4, 4, 2, 1, 1, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

           
'Indsætter overskrift på kolonne G og H
        Range("G1") = "Uge.nr."
        Range("H1") = "Måned"
'---MÅSKE ER PROBLEMET HER - START -------     
'Angiver ugenr. og månednr. ud for alle posteringer
        r = 2
        lastrow = Range("A65536").End(xlUp).Row

        For r = 2 To lastrow
        Cells(r, 7).NumberFormat = "@"
        Cells(r, 8).NumberFormat = "@"
        'Indsætter udover ugenr. også "-åå"
        Cells(r, 7).Value = UgeNr(Cells(r, 1).Value) & "-" & Right(Cells(r, 1), 2)
        Cells(r, 8).Value = Format((Cells(r, 1).Value), "mmm-yy")
        Next r
'---MÅSKE ER PROBLEMET HER - SLUT -------
'Sorter posteringer i stigende retning
        Cells.Select
            Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
       
'Kopier alle saldi ultimo dagen
        Set tilarkDag = Sheets("Dag - Data")
        Set fraarkDag = Sheets("Kontobevægelser")
        lastrow = fraarkDag.Range("A65536").End(xlUp).Row

        rt = 2
        For r = 2 To lastrow
        If Not fraarkDag.Cells(r, 1).Value = fraarkDag.Cells(r + 1, 1).Value Then
        tilarkDag.Cells(rt, 1) = fraarkDag.Cells(r, 1)
        tilarkDag.Cells(rt, 1).NumberFormat = fraarkDag.Cells(r, 1).NumberFormat
        tilarkDag.Cells(rt, 2) = fraarkDag.Cells(r, 5)
        rt = rt + 1
        End If
        Next r
        Sheets("Dag - data").Range("A1") = "Dato"
        Sheets("Dag - data").Range("B1") = "Saldo"
       
'Kopier alle saldi ultimo ugen
        Set tilarkUge = Sheets("Uge - Data")
        Set fraarkUge = Sheets("Kontobevægelser")
        lastrow = fraarkUge.Range("A65536").End(xlUp).Row

        rt = 2
        For r = 2 To lastrow
        If Not fraarkUge.Cells(r, 7).Value = fraarkUge.Cells(r + 1, 7).Value Then
        tilarkUge.Cells(rt, 1) = fraarkUge.Cells(r, 7)
        tilarkUge.Cells(rt, 1).NumberFormat = fraarkUge.Cells(r, 7).NumberFormat
        tilarkUge.Cells(rt, 2) = fraarkUge.Cells(r, 5)
        rt = rt + 1
        End If
        Next r
        Sheets("Uge - data").Range("A1") = "Uge"
        Sheets("Uge - data").Range("B1") = "Saldo"

'Kopier alle saldi ultimo måneden
        Set tilarkMåned = Sheets("Måned - Data")
        Set fraarkMåned = Sheets("Kontobevægelser")
        lastrow = fraarkMåned.Range("A65536").End(xlUp).Row

        rt = 2
        For r = 2 To lastrow
        If Not fraarkMåned.Cells(r, 8).Value = fraarkMåned.Cells(r + 1, 8).Value Then
        tilarkMåned.Cells(rt, 1) = fraarkMåned.Cells(r, 8)
        tilarkMåned.Cells(rt, 1).NumberFormat = fraarkMåned.Cells(r, 8).NumberFormat
        tilarkMåned.Cells(rt, 2) = fraarkMåned.Cells(r, 5)
        rt = rt + 1
        End If
        Next r
        Sheets("Måned - data").Range("A1") = "Måned"
        Sheets("Måned - data").Range("B1") = "Saldo"
End If
        End With
   
Range("A1").Select
Sheets("forside").Select
Application.ScreenUpdating = True

Call IndlæsningAfsluttet
End Sub

'Bruges til at vælge ugenummer i Diagram-makro

Function UgeNr(MyDate) UgeNr = DatePart("ww", MyDate, vbMonday, vbFirstFourDays)
End Function

Sub IndlæsningAfsluttet()
    sLangTekst = "Kontobevægelser er indlæst!" & vbNewLine
    IngenOpdatering = MsgBox(sLangTekst, vbOKOnly + vbInformation, "Data indlæst")
     
End Sub

Spørgsmål lukkes!