Please Help with VBA code

URGENT HELP REQUIRED
... I am VBA noob

My requirement is simple. I need to open the attached FILE.TXT file by the button click and read through each line of file.
Whenever I find the word "polisnummer", I write value of the policy in cell A6 & then the value of "attribuut" in cell B6, the the value of "waarde" in cell C6 & the the value of " foutmelding " in cell D6.

Once the next " polisnummer " string is found, I fill similarly in cell A7,B7,C7,D7....and so on (as evident from the excel)


Attachment 15928
Sample file in the File.ZIP

Code:

---

Public Sub ImportText()
Dim this As Worksheet
Dim txtFile As Workbook
Dim cell As Range
Dim firstaddress As String
Dim nextrow As Long

    Set this = ActiveSheet
    nextrow = 6
   
    With Application.FileDialog(msoFileDialogOpen)
   
        .AllowMultiSelect = False
        .InitialFileName = "File.txt"
        If .Show = -1 Then
       
            Workbooks.OpenText Filename:=.SelectedItems(1), _
                                            DataType:=xlDelimited, _
                                            Tab:=True
                                           
            With ActiveWorkbook
           
                With .Worksheets(1).Columns(1)
           
                    Set cell = .Find("Polisnummer", LookIn:=xlValues)
                    If Not cell Is Nothing Then
                   
                        firstaddress = cell.Address
                        Do
                       
                            this.Cells(nextrow, "B").Value = Trim(Replace(cell.Value, "Polisnummer", ""))
                            this.Cells(nextrow, "C").Value = Trim(Replace(cell.Offset(2, 0).Value, "Attribuut", ""))
                            this.Cells(nextrow, "D").Value = Trim(Replace(cell.Offset(3, 0).Value, "Waarde", ""))
                            this.Cells(nextrow, "E").Value = Trim(Replace(cell.Offset(4, 0).Value, "Foutmelding", ""))
                           
                            Set cell = .FindNext(cell)
                            nextrow = nextrow + 1
                        Loop While Not cell Is Nothing And cell.Address <> firstaddress
                       
                    End If
                End With
               
                .Close SaveChanges:=False
            End With
        End If
    End With
End Sub

---

Quote:

---

Originally Posted by Anirban

URGENT HELP REQUIRED

---

Clearly not the same urgency to say 'Thank-you'.

Thank you XLD

You're welcome Mr Bear!