This should work, it will output one line per selected cell cells are numbered left to right and down, so selecting a single column should work.
In Excel 2000 you can have multiple selection ranges
if you have multiple selection ranges each range will
be processed independently in the order that it each was
selected:    
  i.e.    A1:A5, A3:C3, C2:D5
If you do not want to incude cells that are blank or only
include spaces you can include your own test.
    IF  cell.text <> ""  THEN ...
Option Explicit
Sub OneRowPerCell()
    Dim newrange As Range
    Dim cell As Range
    Dim filename As Variant
    Dim retVal As Variant
    Dim suffix As String
    suffix = ""
 ' Range("B:B").Select   'for testing, normally manually select a column/cells
    Set newrange = Intersect(Selection, ActiveSheet.UsedRange)
                filename = "c:\temp\myfile.txt"
    filename = InputBox("Supply filename for HTML generated from " _
       & "selected range", "Filename for myfile", filename)
    If UCase(Right(filename, 4)) = ".HTM" Then suffix = "<br>"
    Close #1
    Open filename For Output As 1
    For Each cell In newrange
       Print #1, cell.Text & suffix
    Next cell
    Close #1
    '------------------ view results --------------------------.
    If UCase(Right(filename, 4)) = ".HTM" Then
      retVal = Shell("C:\Program Files\Internet Explorer" _
        & "\IEXPLORE.EXE " & filename, vbNormalFocus)
    Else
          retVal = Shell("NOTEPAD.EXE " & filename, vbNormalFocus)
    End If
End Sub
Sub OneRowPerCellPerColumn()
  Dim newrange As Range
  Dim cell As Range
  Dim filename As Variant
  Dim retVal As Variant
  Dim suffix As String
  suffix = ""
  Dim iCol As Long
  Dim Col_id As String
  Dim colRange As Range
  For iCol = 1 To ActiveSheet.UsedRange.Columns.Count
       Set newrange = Intersect(Cells.Columns(iCol), ActiveSheet.UsedRange)
      Col_id = Left(Cells(1, iCol).Address(0, 0), _
           Len(Cells(1, iCol).Address(0, 0)) - 1)
      filename = "c:\temp\myfile_" & Col_id & ".txt"
      If UCase(Right(filename, 4)) = ".HTM" Then suffix = "<br>"
      Close #1   'standard practice, close before opening
      Open filename For Output As 1
      For Each cell In newrange     'newrange
        If Trim(cell.Text) <> "" Then
           Print #1, cell.Text & suffix
        End If
      Next cell
      Close #1
  Next iCol
End Sub
'Code to read file until finished Open "c:\temp\outdoor.csv" for input as #1 do while not eof(1) input #1,x loop closeuses the Line Input # statement to read a line from a sequential file and assign it to a variable.
Open "TESTFILE" For Output As #1 ' Open file for output. Write #1, "Hello World", 234 ' Write comma-delimited data. Write #1, ' Write blank line. MyDate = #February 12, 1969# : MyNull = Null Write #1, MyDate ; " is a date" Close #1 ' Close file.
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\testfile.txt", True)
a.WriteLine("This is a test.")
a.Close
     copy part1.html +passlist.html +part3.html  composite.html
Sub ReadCommaSepFile_NoReturns()
Dim myVar As Variant
Dim i As Long
Dim rw As Long
'Open the file for Input
    Open "C:\Test1.TXT" For Input As #1
'Read each line of the text file into the list of variables
    'until the end of the file is reached
    i = 0
    rw = 1
    Do While Not (EOF(1))
        Input #1, myVar
        i = i + 1
        If i = 4 Then
         Cells(rw, i).Value = CDate(myVar)
        Else
         Cells(rw, i).Value = myVar
        End If
        If i = 6 Then
         rw = rw + 1
         i = 0
        End If
    Loop
'Close the file
    Close 1
End Sub
For more information on Importing and Exporting Text files with your
own delimiters see
Chip Pearson's web pages on
export and import.
Sub Macro23()
   dim retval as variant
   ActiveWorkbook.SaveAs filename:="C:\temp\text.txt", _
      FileFormat:=xlTextPrinter, CreateBackup:=False
   '--- show results ----
   retval = Shell("NOTEPAD.EXE " & _
      "c:\temp\text.txt", vbNormalFocus)
End Sub
If the filename contains spaces, you will have to include it within double quotes. (start Runs a Windows program or an MS-DOS program.) E.g.,
From DOS:
  start c:\copiedsite\dmcritchie\excel\excel.htm
  start "c:\copiedsite\dmcritchie\excel\excel.htm"
  start http://www.mvps.org/dmcritchie/excel/excel.htm
From DOS starting Excel with switches: (291288 - Startup Switches for Microsoft Excel (2002: 291288, 2000: 211481; 97: 159474)
(SAFE Mode, Re-register/Reregister Excel extensions)  )
  Excel.exe /r "C:\test\file.xls"
From VBA:
  Shell "start ""s:\new projects\drawing.dwg"" "
  Shell "start c:\copiedsite\dmcritchie\excel\excel.htm"
  Shell "start ""c:\copiedsite\dmcritchie\excel\excel.htm"""
also look at  GetObject in VBA help.
More VBA:
  Dim pblnHelp As Boolean
  pblnHelp = Shell("start " & " """ & _
     ActiveWorkbook.path & "\help.pdf"" ", vbMaximizedFocus)
Worksheet Solution, thanks to Scott Rubin
                =HYPERLINK("help.pdf","Help and usage information")
Change directory or folder. ChDir Change the drive. ChDrive Copy a file. FileCopy Make directory or folder. MkDir Remove directory or folder. RmDir Rename a file, directory, or folder. Name Return current path. CurDir Return file date/time stamp. FileDateTime Return file, directory, label attributes. GetAttr Return file length. FileLen Return file name or volume label. Dir Set attribute information for a file. SetAttr
Visit [my Excel home page] [Index page] [Excel Onsite Search] [top of this page]
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2006, F. David McRitchie, All Rights Reserved