How to Impot data from a text file to another worksheet.
Hi
untested but try the following:
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim wks as worksheet
set wks=activeworkbook.worksheets("Names")
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
SaveColNdx = wks.Range("A1").Column
RowNdx = wks.Range("A1").Row
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
wks.Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
--
Regards
Frank Kabel
Frankfurt, Germany
TroyH wrote:
I have used the following code, which I found here. I am sorry I do
not remember who the originator was, but the code works great except
that I am having problems getting it to write to another worksheet.
I need this macro to work in the background and copy the data from a
text file to the worksheet "Names". The worksheet "Names" is hidden.
I tried the following but it does not work. It will only copy the
data onto the active worksheet.
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
SaveColNdx = Worksheets("Names").Range("A1").Column
'SaveColNdx = ActiveCell.Column '<<< Original Code
RowNdx = Worksheets("Names").Range("A1").Row
'RowNdx = ActiveCell.Row '<<< Original Code
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
Any help will be very welcome. Thanks.
|