Macro con extensión rem y jor

Cómo especifico en esta macro que el bloc de notas que se guardará debe tener la extensión rem y jor, (como un formato personalizado), para que no sea txt .Es decir que quede así el nombre 060120170420557390562.REM. Gracias por sus comentarios

Sub generar_texto45()
'
' SUERTE Macro
'
' Acceso directo: CTRL+l
'
Dim miRuta As String, miCarpeta As String, miSubcarp As String
'tomo la ruta del libro
miRuta = "C:\"
'el nombre de carpeta se toma de A2
miCarpeta = "C:\Users\EMPERATRIZ\Desktop\PLAME CLIENTES-SUNAT"

'el nombre de subcarpeta se toma de A5
miSubcarp = "C:\Users\EMPERATRIZ\Desktop\PLAME CLIENTES-SUNAT" & "\" & Range("D1")
On Error Resume Next
'primero se crea la carpeta
MkDir miRuta & "\" & miCarpeta
'luego la subcarpeta
MkDir miRuta & "\" & miCarpeta & "\" & miSubcarp
'Por.DAM
Ruta = "C:\Users\EMPERATRIZ\Desktop\PLAME CLIENTES-SUNAT" & "\" & Range("D1")
arch = Range("I1")
Range("G5").Select
Selection.Copy
Range("G6").Select
ActiveSheet.Paste
UltimaFila = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Selection.AutoFill Destination:=Range("G6:G" & Range("C" & Rows.Count).End(xlUp).Row)
Selection.Copy
finfila = Range("C63514").End(xlUp).Row
Range("G6:G" & finfila).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Ruta & "\" & arch, FileFormat = "Archivos de texto (*.rem)"
ActiveWorkbook.Close
MsgBox ("Archivo generado exitosamente")
Application.ScreenUpdating = True
End Sub