> При нажатие на кнопку принтер, необходимо распечатать лист в двух экземплярах;  
 
это должно работать для любого файла, или для одного\нескольких выбранных?  
который лист распечатываем? активный, или какой-то определённый?  
 
> После автоматически предложить сохранить на рабочем столе  
 
А зачем предлагать?  
Может, сразу взять и сохранить, без лишних вопросов?

Спасибо сделал так...  
Private Sub Workbook_BeforePrint(Cancel As Boolean)  
Application.EnableEvents = False  
Worksheets("Список").PrintOut Copies:=1  
Call CB  
End Sub  
 
Sub CB()  
Application.Dialogs(xlDialogSaveAs).Show  
End Sub  
 
Copies:=1 - Потому что в сочетание с макросом CB печатает ещё один экземпляр.  
Дополнительный вопрос как на появляющейся форме блокировать кнопку "Отмена"?

Не печатает!  
А сохраняет отлично спасибо, проблема только если понадобиться сохранить/распечатать новый документ, то предлагает заменить существующий. Можно что бы он продалжал сохранять например так Список за 08 06 2010(1).xls далее Список за 08 06 2010(2).xls ну и т.д.???

' формируем имя файла, и сохраняем текущий файл под этим именем  
' проверка наличия файла в папке РАБОЧИЙ СТОЛ  
Dim ПроверяемНаличиеФайла As Object  
ПроверяемНаличиеФайла = ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY") & ".xls"  
For each ПроверяемНаличиеФайла in ПутьКРабочемуСтолу    
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY") & ".xls"  
if not ПроверяемНаличиеФайла is Nothing Then  
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY") & ".xls"  
Esle  
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY") & "(2)" & ".xls"  
Next  
 
Попробуйте так, возможно получится.

> Можно что бы он продалжал сохранять например так Список за 08 06 2010(1).xls далее Список за 08 06 2010(2).xls ну и т.д.???  
 
Я обычно в таких случаях добавляю в имя файла текущее время.  
Вряд ли за 1 секунду вы успеете дважды нажать на кнопку Печать, так что проблем быть не должно.  
 
Выглядеть код будет так:  
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY HH-NN-SS") & ".xls"

И ещё...  
Возможно ли чтобы в сохраняемом файле:  
Во-первых, удалялись все формулы на листе (оставались только значения);  
Во-вторых, удалялись все макросы;  
В-третьих, менялись свойства ячеек определенного диапазона на защищаемые.

Возможно всё  
 
1. одна строка кода  
activesheet.usedrange.value=activesheet.usedrange.value  
 
2. ищем макрос DeleteAllVBACode на этой странице:    
http://excelvba.ru/code/VBE  
 
3. опять же, одна строка кода: range("b5:g16").Locked=true  
ну и потом надо поставить защиту на лист, и после этого сохранить файл.

Да нет все работает СПАСИБО БОЛЬШОЕ, может это даже и лучше (проверил 5 раз)...  
Остальные вопросы актуальны

Простите, последнее забы он стал спрашивать сохранить?  
Private Sub Workbook_BeforePrint(Cancel As Boolean)  
Application.EnableEvents = False  
Cancel = True ' отменяем встроенную команду ПЕЧАТЬ  
Worksheets("Список").PrintOut Copies:=2 ' печатаем 2 копии листа  
' получаем путь к папке РАБОЧИЙ СТОЛ  
ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"  
' формируем имя файла, и сохраняем текущий файл под этим именем  
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY HH-NN-SS") & ".xls"  
Range("B21:R30").Locked = True  
Call Q  
ThisWorkbook.Close  
Application.EnableEvents = True  
End Sub  
 
Как заблокировать данное сообщение, и без запроса сохранять????

Вот так попробуйте  
ThisWorkbook.Close False  
Application.EnableEvents = True  
End Sub

Большое спасибо!!!  
Private Sub Workbook_BeforePrint(Cancel As Boolean)  
        Application.EnableEvents = False  
Cancel = True ' отменяем встроенную команду ПЕЧАТЬ  
If IsEmpty(Cells(13, 5)) Then  
MsgBox "Извините, но Вы не выбрали название Юридического лица!?"  
 
ElseIf IsEmpty(Cells(14, 16)) Then  
MsgBox "Извините, но Вы не указали ПФП (Подразделение/проект финансового планирования)!?"  
 
ElseIf IsEmpty(Cells(14, 5)) Then  
MsgBox "Извините, но Вы не выбрали свою Должность!?"  
 
ElseIf IsEmpty(Cells(15, 5)) Then  
MsgBox "Извините, но Вы не указали Ф.И.О. Отправителя!?"  
 
ElseIf IsEmpty(Cells(15, 16)) Then  
MsgBox "Извините, но Вы не указали добавочный номер своего телефона!?"  
 
ElseIf IsEmpty(Cells(16, 5)) Then  
MsgBox "Извините, но Вы не указали Адрес отправителя!?"  
 
ElseIf IsEmpty(Cells(16, 16)) Then  
MsgBox "Извините, но Вы не указали городской номер телефона!?"  
 
        Else: Cancel = False 'форма заполнена  
        End If  
Worksheets("Список").PrintOut Copies:=2 ' печатаем 2 копии листа  
' получаем путь к папке РАБОЧИЙ СТОЛ  
ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"  
' формируем имя файла, и сохраняем текущий файл под этим именем  
ThisWorkbook.SaveAs ПутьКРабочемуСтолу & "Список за " & Format(Now, "DD MM YYYY HH-NN-SS") & ".xls"  
ThisWorkbook.Close  
Application.EnableEvents = True  
End Sub  
 
Чего то здесь напутал, что ли??? Проверяет заполнены ли ячейки, но даже если не заполнено (т.е. после предупреждения нажимаешь "OK") продолжает печатать и сохраняет новый файл.

После каждого ElseIf IsEmpty  
строку:  
Application.EnableEvents = True: Exit sub  
Наверно так, или Go To  в конец процедуры;)