Public Function AllPrinters() As String
    ' Used: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
    Const HKEY_CURRENT_USER = &H80000001
    Dim regobj As Object
    Dim aTypes As Variant
    Dim aDevices As Variant
    Dim vDevice As Variant
    Dim sValue As String
    Dim Printer As String
        
    ' connect to WMI registry provider on current machine with current user
    Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
       
    ' get the Devices from the registry
    regobj.EnumValues HKEY_CURRENT_USER, _
    "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
       
    ' find Printer and create full name
    For Each Printer In AllPrinters
        For Each vDevice In aDevices
            ' get port of device
            regobj.GetStringValue HKEY_CURRENT_USER, _
            "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
        Next
        Printer = vDevice & " " & Split(sValue, ",")(1)
    Next
End Function

For Each vDevice In aDevices
regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
Printers() = vDevice & " " & Split(sValue, ",")(1)
Next

Public Function AllPrinters() As String
    ' Used: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
    Const HKEY_CURRENT_USER = &H80000001
    Dim regobj As Object
    Dim aTypes As Variant
    Dim aDevices As Variant
    Dim vDevice As Variant
    Dim sValue As String
    
    ' connect to WMI registry provider on current machine with current user
    Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
       
    ' get the Devices from the registry
    regobj.EnumValues HKEY_CURRENT_USER, _
    "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
       
    ' find Printer and create full name
    For Each vDevice In aDevices
        ' get port of device
        regobj.GetStringValue HKEY_CURRENT_USER, _
        "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
    Next
    AllPrinters = vDevice & " " & Split(sValue, ",")(1)
End Function

Sub SeePRN()
    Dim Printer As Variant
    Printer = AllPrinters()
    Debug.Print Printer
End Sub

Private Sub ListPrinters()    
    Dim obprinter As Object
    Dim allprinters As Object
    Dim i As Byte
    Dim port As String
    Set allprinters = GetObject("winmgmts://./root/CIMV2") _
    .ExecQuery("SELECT * FROM Win32_Printer", , 48)
    For Each obprinter In allprinters
        i = i + 1
        If ActivePrinter Like " * " & obprinter.Name & " * " Then
            port = Replace(ActivePrinter, obprinter.Name, "")
    Exit For
        End If
    Debug.Print port
End Sub

Private Sub ListPrinters()
    Dim wshNetwork As Object
    Dim oPrinters As Object
    Dim iCount As Integer
    Set wshNetwork = CreateObject("WScript.Network")
    Set oPrinters = wshNetwork.EnumPrinterConnections
    For iCount = 0 To oPrinters.Count - 1 Step 2
    Debug.Print oPrinters.Item(iCount + 1)
    Next
End Sub

Private Sub test_GetPrinterFullName()
    Dim sPrinter As String
    sPrinter = GetPrinterFullName
    MsgBox sPrinter
End Sub

Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _
Collate:=True, Copies:=2, ActivePrinter:="2Sided CM6030 [8E5E17] (Ne05:)"

Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _
Collate:=True, Copies:=2, ActivePrinter:="2Sided"&"?????????????????????????????"

Private Sub PRN_BTN_Click()
   ThisWorkbook.Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _
      Collate:=True, Copies:=2, ActivePrinter:=FindPrinterByPattern("(?:^| )2Sided(?: |$)")
      .Close True
   End With
   Kill ThisWorkbook.Path & "\New.xlsx"
End Sub

Sub io()    
    ThisWorkbook.Sheets(Array(2, 3)).Copy    
    With ActiveWorkbook       
        .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"       
        Workbooks("New.xlsx").Sheets("ТТН_1").Orientation = xlLandscape       
        Workbooks("New.xlsx").Sheets("ТТН_2").Orientation = xlLandscape       
        Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _       
        Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"       
        .Close True    
    End With    
    Kill ThisWorkbook.Path & "\New.xlsx" 
End Sub 

With Workbooks("New.xlsx")
          .Sheets(1).PageSetup.Orientation = xlLandscape
          .Sheets(2).PageSetup.Orientation = xlLandscape
      End With

Sub io()   
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      .Close True
   End With
   Kill ThisWorkbook.Path & "\New.xlsx"
End Sub

Sub io()
   Dim objFSO As Object, objFile As Object
   Dim sFileName As String
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      Workbook("New.xlsx").PrintOut Copies:=1, _
      ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
      .Close True
   End With
   sFileName = ThisWorkbook.Path & "\New.xlsx"
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFile = objFSO.GetFile(sFileName)
   objFile.Delete
End Sub

Sub io()
   Dim objFSO As Object, objFile As Object
   Dim sFileName As String
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      .Close True
   End With
   sFileName = ThisWorkbook.Path & "\New.xlsx"
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFile = objFSO.GetFile(sFileName)
   objFile.Delete
End Sub

Sub io()
Sheets(Array(2, 3)).Copy
With ActiveWorkbook
   .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"   
End With
End Sub

Sub Delete_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String
 
    sFileName = "C:\WWW.xls"    'имя файла для удаления
 
    If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
 
    'удаляем файл
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Delete
    MsgBox "Файл удален", vbInformation, "www.excel-vba.ru"
End Sub

sFileName = "C:\WWW.xls"

Sub io()
   Dim objFSO As Object, objFile As Object
   Dim sFileName As String
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      .Close True
   End With
   sFileName = ThisWorkbook.Path & "\New.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(sFileName)
objFile.Delete
End Sub

Application.Wait Now + TimeSerial(0, 0, 5)

Sub io()
   Dim objFSO As Object, objFile As Object
   Dim sFileName As String
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      .Close True
   End With
   Application.Wait Now + TimeSerial(0, 0, 5)
   sFileName = ThisWorkbook.Path & "\New.xlsx"
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFile = objFSO.GetFile(sFileName)
   objFile.Delete
End Sub

Sub copy()  
    Dim wb As Workbook  
    Set wb = Workbooks.Open("c:\temp\другая книга.xlsm", ReadOnly:=True)  
    wb.Sheets("ТТН_1").Copy before:=ThisWorkbook.Sheets(1)  
    wb.Close False  
End Sub

Private Sub PRN_BTN_Click()
    Dim wb As Workbook    
    Set wb = Workbooks.Open("c:\temp\neworkbook.xlsm", ReadOnly:=False)
    wb.Sheets(Array(2, 3)).Copy before:=ThisWorkbook.Sheets(1)
    wb.Close False
    Workbooks(wb).Sheets(Array(2, 3)).PrintOut Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
End Sub

Private Sub Save_BTN_Click()
    With Sheets("Реестр ТТН")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       If IsNull(Var) = True Or Var = 0 Then
          lastrow = 1
          Var = 0
       End If
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 2) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(5, 28)
       .Cells(lastrow + 1, 3) = Sheets("ТТН_1").Cells(11, 22)
       .Cells(lastrow + 1, 4) = Sheets("ТТН_1").Cells(9, 22)
       .Cells(lastrow + 1, 5) = Sheets("Форма").Cells(2, 49)
    End With
    With Sheets("Реестр Путевок")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       If IsNull(Var) = True Or Var = 0 Then
          lastrow = 1
          Var = 0
       End If
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 8) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(2, 49)
       .Cells(lastrow + 1, 3) = Sheets("Форма").Cells(5, 28)
    End With
End Sub

?Application.ActivePrinter

Private Sub PRN_BTN_Click()
    ThisWorkbook.Sheets(Array(1, 2)).PrintOut Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
End Sub

Private Sub Save_BTN_Click()
    With Sheets("Реестр ТТН")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       If IsNull(Var) = True Or Var = 0 Then
          lastrow = 1
          Var = 1
       End If
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 2) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(5, 28)
       .Cells(lastrow + 1, 3) = Sheets("ТТН_1").Cells(11, 22)
       .Cells(lastrow + 1, 4) = Sheets("ТТН_1").Cells(9, 22)
       .Cells(lastrow + 1, 5) = Sheets("Форма").Cells(2, 49)
    End With
    With Sheets("Реестр Путевок")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       If IsNull(Var) = True Or Var = 0 Then
          lastrow = 1
          Var = 1
       End If
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 8) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(2, 49)
       .Cells(lastrow + 1, 3) = Sheets("Форма").Cells(5, 28)
    End With
End Sub

lastrow = 0Var = 0

Private Sub Save_BTN_Click()
    With Sheets("Реестр ТТН")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 2) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(5, 28)
       .Cells(lastrow + 1, 3) = Sheets("ТТН_1").Cells(11, 22)
       .Cells(lastrow + 1, 4) = Sheets("ТТН_1").Cells(9, 22)
       .Cells(lastrow + 1, 5) = Sheets("Форма").Cells(2, 49)
    End With
    With Sheets("Реестр Путевок")
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Var = .Cells(lastrow, 1).Value
       .Cells(lastrow + 1, 1) = Var + 1
       Sheets("Форма").Cells(5, 8) = Var + 1
       .Cells(lastrow + 1, 2) = Sheets("Форма").Cells(2, 49)
       .Cells(lastrow + 1, 3) = Sheets("Форма").Cells(5, 28)
    End With
End Sub

Var = .Cells(lastrow, 1).Value
.Cells(lastrow + 1, 1) = Var + 1
Sheets("Форма").Cells(5, 2) = Var + 1