Проверяйте - результат в файле: http://excelvba.ru/XL_Files/Sample__22-11-2010__5-55-08.zip  
(сначала извлеките файл из архива куда-нибудь на комп)  
 
 
Вот весь код:  
 
Sub test()  
   Dim cell As Range  
   Путь = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "")  
   For Each cell In Selection.Cells  
       SaveTXTfile Путь & cell.Address & ".txt", cell  
   Next cell  
End Sub  
 
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean  
   On Error Resume Next: Err.Clear  
   Set fso = CreateObject("scripting.filesystemobject")  
   Set ts = fso.CreateTextFile(filename, True)  
   ts.Write txt: ts.Close  
   SaveTXTfile = Err = 0  
   Set ts = Nothing: Set fso = Nothing  
End Function  
 
 
Макрос создаёт текстовые файлы примерно с такими именами:  
(вы же не сказали, как следует именовать файлы...)  
 
$D$14.txt  
$B$15.txt  
$B$16.txt  
$B$17.txt  
$C$12.txt  
$C$13.txt  
$C$14.txt  
$C$15.txt  
$C$16.txt  
$C$17.txt  
$D$12.txt  
$D$13.txt

2 EducatedFool  
 
Привет, Игорь!  
Небольшая поправка к этой строке:  
 
Путь = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "")  
 
Хотя вероятность этого небольшая, имя книги может содержаться в пути. Например, папка называется так же, как книга:  
 
?ThisWorkbook.fullname  
B:\Temp\post_176738.xls\post_176738.xls  
 
Тогда  
?Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "")  
B:\Temp\\  
 
И возникает ошибка.  
Наверно, лучше  
Путь = ThisWorkbook.path & "\"  
или  
Путь = ThisWorkbook.path & application.PathSeparator

> А вот случаев, когда люди сохраняют файлы в корень диска, - предостаточно.  
И тут вариант ThisWorkbook.path & "\" выдаёт ошибку "c:\\"  
 
Не вижу проблемы! Сохранил в корень диска, вот что получается:  
 
?ThisWorkbook.path' & application.PathSeparator    
C:  
 
?ThisWorkbook.path & application.PathSeparator    
C:\  
 
Это WinXP, Офис 2007. Может, на более поздних версиях по-другому?