Importeren CSV file

[CruzNP]

Beste,

Op mijn werk maken we Autocad tekeningen van systeemkasten.
Hiervan exporteren we de block gegevens naar een csv bestand.

Ik probeer met de volgende code een CSV file deze gegevens te importeren in een excel bestand.

De eerste keer gaat goed echter bestaat een systeem uit meerdere kasten.
Bij de tweede keer schuift hij de cellen op en op een of andere manier wordt er een link gemaakt die ik ook niet wil.\

Kan iemand deze code aanpassen dat ik steeds op de actieve cell een CSV bestand importeer?

Alvast bedankt,

Code:
Private Sub CommandButton8_Click()
Dim ws As Worksheet
Dim i As String
Dim fStr As String
ActiveCell.Select


With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
Exit Sub
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)

End With
With ThisWorkbook.Sheets("PART LIST").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=ThisWorkbook.Sheets("PART LIST").Range("$A$7"))
.Name = "CAPTURE"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

Do
i = ActiveCell.Offset(0, 2)
If Not i = "" Then

On Error Resume Next
With Worksheets("Gegevens").Range("B:B")
i = ActiveCell.Offset(0, 2)
Set p = .Find(i, LookIn:=xlValues, lookat:=xlWhole)
If Not p Is Nothing Then

ActiveCell.Offset(0, 1) = Worksheets("gegevens").Range("A" & p.Row).Value
ActiveCell.Offset(0, 3) = Worksheets("gegevens").Range("C" & p.Row).Value

Else

End If
End With
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell.Offset(0, 2))
End With
End Sub