Finde sidste dato i kolonne

Sub workbook_activate()
    With ActiveWorkbook.Sheets(1)                          'behandler 1.Ark
        antalræk = ActiveCell.SpecialCells(xlLastCell).Row  'optæller antal rækker
       
        For r = antalræk To 1 Step -1                      'gennemløber antal rækker - baglæns kolonne A
            If IsDate(.Cells(r, 1)) = True Then            'er det en dato
                Cells(10, 8) = .Cells(r, 1)                'indsæt i H10
                Exit For                                    'afbryd løkke
            End If
        Next r
    End With
End Sub

Hvor skal jeg indsætte denne kode og hvordan aktiveres den??

Alt+F11 / VBA-vinduet vises / Indsæt koden i Ark1 (dobbeltklik forat åbne)

Ikke for at blande mig, men er det en tilføjelse til den importkode, jeg lavede.

Så kan den kodes ind i importen.

der var også en rettelse til datoen, den blev indlæst som en tekst
her er nederste del af import koden.

  For I = 0 To P
            A = Split(strline(I), ";")
            RES(I, 0) = DateValue(A(0))
            RES(I, 1) = A(1)
            RES(I, 2) = A(2)
            RES(I, 3) = A(3)
            RES(I, 4) = A(4) * 1
            If A(4) < 0 Then
                RES(I, 5) = A(5) * -1
            Else
                RES(I, 5) = A(5) * 1
            End If

            RES(I, 6) = A(6) * 1
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(P, 0)) = RES
        [H10] = RES(I - 1, 0)
        Range("E1").CurrentRegion.Font.Strikethrough = False    ' fjern gennemstregning ved indlæsning
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub

Hej Alle
Jeg er lidt forviret hvad jeg skal.
Ja kabbak det er til det ark du har lavet meget til. Det er for at indsætte sidste dato fra import filen I celle H10. Hvor skal jeg indsætte den.??
/Petert

Udskifte den nederste del af koden i din kode, fra hvor den starter med

For I = 0 To P

hvis du er i tvivl, så smid importkoden herind, så skal jeg sætte det ind, jeg kan jo ikke vide om du har ændret i den siden sidst.

Det virkede fint med der er en rettelse vedr. datoen der indsættes i H8 den skrives med måned før dato og ikke dato måned som det gerne skulle være. Kan dette rettes jeg vedlægger importkoden.
Public Sub HenttxtData()
    Dim strline() As Variant, X As Long, Str As String, fileToOpen As String
    Dim RES() As Variant, I As Long, A As Variant, P As Long
    fileToOpen = "C:\Data\konti\konto 90020.txt" ' ret her hvis det er en anden fil
'    fileToOpen = "C:\test\konto 90020.txt"
    If Dir(fileToOpen) <> "" Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        [I8] = Split(Str, vbTab)(4) * 1
        [I8].NumberFormat = "$ #,##0.00"
        [H8] = Split(Str, vbTab)(0)
        X = 0
     
        Do
            Line Input #1, Str
            If Str = "" Then
       
                Exit Do
            End If
            ReDim Preserve strline(X)
            A = Split(Str, vbTab)
            strline(X) = A(0)
            strline(X) = strline(X) & ";" & A(1)
            strline(X) = strline(X) & ";" & A(6)
            strline(X) = strline(X) & ";" & A(7)
            strline(X) = strline(X) & ";" & A(8)
            strline(X) = strline(X) & ";" & A(9)
            strline(X) = strline(X) & ";" & A(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1
     
        P = X - 1
        ReDim RES(P, 6)
     
        For I = 0 To P
            A = Split(strline(I), ";")
            RES(I, 0) = DateValue(A(0))
            RES(I, 1) = A(1)
            RES(I, 2) = A(2)
            RES(I, 3) = A(3)
            RES(I, 4) = A(4) * 1
            If A(4) < 0 Then
                RES(I, 5) = A(5) * -1
            Else
                RES(I, 5) = A(5) * 1
            End If

            RES(I, 6) = A(6) * 1
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(P, 0)) = RES
        [H10] = RES(I - 1, 0)
        Range("E1").CurrentRegion.Font.Strikethrough = False    ' fjern gennemstregning ved indlæsning
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub

Til kabbak
Endelig vil jeg høre kan det lade sig gøre at lave en makro der ophæver gennemstregninger i celler der er makeret.
modsat denne makro jeg vedlægger her
Sub GennemstregMarkerede()
    Selection.Font.Strikethrough = True
End Sub
/petert

Public Sub HenttxtData()
    Dim strline() As Variant, X As Long, Str As String, fileToOpen As String
    Dim RES() As Variant, I As Long, A As Variant, P As Long
    fileToOpen = "C:\Data\konti\konto 90020.txt" ' ret her hvis det er en anden fil
'    fileToOpen = "C:\test\konto 90020.txt"
    If Dir(fileToOpen) <> "" Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        [I8] = Split(Str, vbTab)(4) * 1
        [I8].NumberFormat = "$ #,##0.00"
        [H8] = Split(Str, vbTab)(0)
        X = 0
   
        Do
            Line Input #1, Str
            If Str = "" Then
     
                Exit Do
            End If
            ReDim Preserve strline(X)
            A = Split(Str, vbTab)
            strline(X) = A(0)
            strline(X) = strline(X) & ";" & A(1)
            strline(X) = strline(X) & ";" & A(6)
            strline(X) = strline(X) & ";" & A(7)
            strline(X) = strline(X) & ";" & A(8)
            strline(X) = strline(X) & ";" & A(9)
            strline(X) = strline(X) & ";" & A(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1
   
        P = X - 1
        ReDim RES(P, 6)
   
        For I = 0 To P
            A = Split(strline(I), ";")
            RES(I, 0) = DateSerial(Split(A(0), "-")(2), Split(A(0), "-")(1), Split(A(0), "-")(0))
            RES(I, 1) = A(1)
            RES(I, 2) = A(2)
            RES(I, 3) = A(3)
            RES(I, 4) = A(4) * 1
            If A(4) < 0 Then
                RES(I, 5) = A(5) * -1
            Else
                RES(I, 5) = A(5) * 1
            End If

            RES(I, 6) = A(6) * 1
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(P, 0)) = RES
        [H10] = RES(I - 1, 0)
        Range("E1").CurrentRegion.Font.Strikethrough = False    ' fjern gennemstregning ved indlæsning
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub



Sub FjernGennemstregMarkerede()
    Selection.Font.Strikethrough = false
End Sub

Mange tak til alle for god hjælp
/Petert

Jeg har lige opdaget der er stadig problemer med visning af datoer.
I H10 vises datoen som 31-12-2006 dette er ok
I H8 vises datoen 12-01-2006 det skulle være 01-12-2006
når jeg ser på formateringen af cellerne er de begge sat til Dato *14-03-2001 Dansk
/petert

sorry, havde overset den

Public Sub HenttxtData()
    Dim strline() As Variant, X As Long, Str As String, fileToOpen As String
    Dim RES() As Variant, I As Long, A As Variant, P As Long, D As String
    fileToOpen = "C:\Data\konti\konto 90020.txt"    ' ret her hvis det er en anden fil
    '    fileToOpen = "C:\test\konto 90020.txt"
    If Dir(fileToOpen) <> "" Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        [I8] = Split(Str, vbTab)(4) * 1
        [I8].NumberFormat = "$ #,##0.00"
        D = Split(Str, vbTab)(0)
        [H8] = DateSerial(Split(D, "-")(2), Split(D, "-")(1), Split(D, "-")(0))
        X = 0

        Do
            Line Input #1, Str
            If Str = "" Then

                Exit Do
            End If
            ReDim Preserve strline(X)
            A = Split(Str, vbTab)
            strline(X) = A(0)
            strline(X) = strline(X) & ";" & A(1)
            strline(X) = strline(X) & ";" & A(6)
            strline(X) = strline(X) & ";" & A(7)
            strline(X) = strline(X) & ";" & A(8)
            strline(X) = strline(X) & ";" & A(9)
            strline(X) = strline(X) & ";" & A(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1

        P = X - 1
        ReDim RES(P, 6)

        For I = 0 To P
            A = Split(strline(I), ";")
            RES(I, 0) = DateSerial(Split(A(0), "-")(2), Split(A(0), "-")(1), Split(A(0), "-")(0))
            RES(I, 1) = A(1)
            RES(I, 2) = A(2)
            RES(I, 3) = A(3)
            RES(I, 4) = A(4) * 1
            If A(4) < 0 Then
                RES(I, 5) = A(5) * -1
            Else
                RES(I, 5) = A(5) * 1
            End If

            RES(I, 6) = A(6) * 1
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(P, 0)) = RES
        [H10] = RES(I - 1, 0)
        Range("E1").CurrentRegion.Font.Strikethrough = False    ' fjern gennemstregning ved indlæsning
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub

Sådan lige i øjet tak for kampen kabbak.Det skal stå sin prøve i morgen
/petert