can you upload the "real" file. your sheet has 6 columns to fill, so
i am thinking there are rows in the textfile that has "less" than 6 columns.
overwrite my subs with this one. if still does not work upload your "real" textfile.
'arnelgp
Private Sub Import_Textfile(ByVal tFile As String)
Debug.Print tFile
Dim first_row As Long, last_row As Long
Dim content As String, var As Variant
Dim cols As Integer
Dim iFile As Integer
Dim i As Long, j As Long
Dim sht As Worksheet
Set sht = ActiveSheet
first_row = 3
last_row = LastRow(sht.Range("a1")) + 1
iFile = FreeFile
Open tFile For Input As #iFile
Line Input #iFile, content
While Not EOF(iFile)
i = i + 1
If i > 1 Then
var = Split(content, ";")
cols = 6
If UBound(var) < 6 Then
cols = UBound(var)
End If
For j = 0 To cols Step 1
sht.Cells(last_row, j + 1) = var(j)
Next
last_row = last_row + 1
End If
Line Input #iFile, content
Wend
If i > 1 Then
var = Split(content, ";")
For j = 0 To 6 Step 1
sht.Cells(last_row, j + 1) = var(j)
Next
End If
Close #iFile
sht.Range("H3:J3").Select
Selection.Copy
sht.Range("H4:J" & last_row).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
sht.Range("A1").Select
End Sub
Public Function LastRow(ByRef Rng As Range)
With Rng.Parent
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Function
Reply With Quote
