Sub SaveEachSheet()  
   Dim wb As Workbook, sh As Worksheet, pt As Variant  
   Set wb = ActiveWorkbook  
   With Application.FileDialog(msoFileDialogFolderPicker)  
       .Title = "Выберите папку для сохранения листов активного файла"  
       .AllowMultiSelect = False  
       If .Show = 0 Then Exit Sub  
       pt = .SelectedItems(1)  
   End With  
   For Each sh In wb.Worksheets  
       sh.SaveAs Filename:=pt & "\" & sh.Name & ".txt", FileFormat:=xlTextWindows  
   Next sh  
End Sub

Женя, а если надо сохранить в xls? а не в txt, что надо поменять?  
Заранее спасибо!

{quote}{login=genyaa}{date=09.10.2007 12:04}{thema=}{post}так:  
sh.SaveAs Filename:=pt & "\" & sh.Name & ".xls", FileFormat:=xlWorkbookNormal{/post}{/quote}  
 
мне кажется, что это не будет работать!...  
sh.SaveAs для XLS формата не пойдёт.  
а wb.SaveAs сохранит всю книгу (со всеми листами)!  
 
позволю себе встрять в разговор и предложить  
 вот такой вариант на основе кода от Genyaa ©  
 
Sub SaveEachSheetAsExcel()  
Dim NewWb, wb As Workbook, NewShet, sh As Worksheet, pt As Variant  
Set wb = ActiveWorkbook  
With Application.FileDialog(msoFileDialogFolderPicker)  
.Title = "Выберите папку для сохранения листов активного файла"  
.AllowMultiSelect = False  
If .Show = 0 Then Exit Sub  
pt = .SelectedItems(1)  
End With  
For Each sh In wb.Worksheets  
  Set NewWb = Application.Workbooks.Add 'Создаем новую книгу  
  Set NewShet = NewWb.Worksheets.Add 'Добавляем лист в нашу книгу  
  sh.Cells.Copy Destination:=NewShet.Cells  
  NewWb.SaveAs Filename:=pt & "\" & sh.Name & ".xls", _  
       FileFormat:=xlNormal, Password:="", WriteResPassword:="", _  
       ReadOnlyRecommended:=False, CreateBackup:=False  
  NewWb.Close 'Ну и закрываем книгу  
  Set NewWb = Nothing  
Next sh  
End Sub  
 
есть недостаток - листы при сохранении теряют своё имя. и лишние листы остаются в сохраннёной книге! Бороться можно, но только я это смогу сделать через on error ...  
посмотрим, какой вариант предложит Genyaa.

Спасибо!!!  
В текст хорошо сохраняет вариант Жени, а в excel вариант Сергея.  
Еще раз благодарю.

{quote}{login=genyaa}{date=09.10.2007 12:04}{thema=}{post}Да, но вот так будет:  
sh.SaveAs Filename:=pt & "\" & sh.Name & ".xls", FileFormat:=xlWorkbook  
 
Правда, действительно, имя исходной книги после отработки процедуры становится таким, как имя последнего сохраненного листа (что несколько странно, на мой взгляд), но и эта проблема легко решается простым закрытием исходной книги без сохранения.{/post}{/quote}  
 
не хочу вступать в дискуссию, однако, позвольте не согласиться. Данный код, безусловно работает, однако он сохраняет ВСЕ листы, имеющиеся в данной книге (активным=текущим становится лист, имя которого взято для сохранения книги., но остальные тоже присутствуют!!!)  
 
вспоминается высказываение одного чела по поводу того, что ему пять раз прислали по эл. почте один и тот же xls файл, только сохранённый пять раз с разным активным листом... ;-)))  
 
тем более, что, как я понял со слов Игоря - проблема уже решена.