Como generar dos archivos idénticos en dos carpetas diferentes

Como puedo hacerle para generar dos archivos idénticos .txt pero colocarlos en dos carpetas o rutas diferentes.

Private Sub CommandButton1_Click()

Dim NombreArchivo, RutaArchivo As String
Dim nbre
Dim nbre2
Dim obj As FileSystemObject
Dim tx As Scripting.TextStream
Dim Ht As Worksheet
Dim i, j, nFilas, nColumnas As Integer
Genera.Hide
Unload Genera
Genera.Show
nbre = [B2]
nbre2 = [I1]
RutaArchivo = "D:\PERSONAL\ASN\ASN" & "\" & nbre & "_" & nbre2 & ".txt"
Set Ht = Worksheets("GENERAR_ASN")
Set obj = New FileSystemObject
Set tx = obj.CreateTextFile(RutaArchivo)
nColumnas = Ht.Range("A1", Ht.Range("A1").End(xlToRight)).Cells.Count
nFilas = Ht.Range("A2", Ht.Range("A2").End(xlDown)).Cells.Count
For i = 1 To nFilas
For j = 1 To nColumnas
tx.Write Ht.Cells(i + 1, j).Value
If j <= nColumnas Then tx.Write "|"
Next j
tx.WriteLine
Next i
tx.Close
Set obj = Nothing
Sheets("VBA").Select

End Sub

Este es el código para generar el archivo