Macro genera archivo de solo lectura, sin razon alguna

Buenas,

Hay alguna razon por la cual cuando se ejecuta una Macro, se genere un archvio de solo lectura alterno al original? El codigo que uso es este:

Sub TrapasarTrimestre2() 'Leyendo cadena de texto

Dim Anio%, Trimes As Variant
Dim Conn As Object, rst As Object, SQL$
Dim Ruta$, Datos As Worksheet, RELACION As Worksheet, Rubro$, Tabla$, Campos$, RutaTriAnt$
Dim LibroDestino As Workbook, Z As Long, Condicion$, Cm%, Columnas As Variant, CamposRecord As Variant
Dim FIni As Date, FFinal As Date ', UltFila As Double
Dim HojaActual As Worksheet, Uf As Double, x As Long, y As Long
Dim LibroTriAnt As Workbook

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Volatile False
End With

Trimes = Val(Trim(InputBox("Esctiba el trimestre a procesar", "Trimestre")))
If Not IsNumeric(Trimes) Or Trimes < 1 Or Trimes > 4 Or Trimes = 0 Then MsgBox "La Opcion debe ser 1 A 4!!", 64, "Trimestres": Exit Sub

Set Conn = CreateObject("adodb.Connection")
Set rst = CreateObject("adodb.Recordset")
Set Datos = Sheets("DATOS")
Set RELACION = Sheets("RELACION")

Anio = Datos.Range("J6")

With Conn
  .Provider = "Microsoft.ACE.OLEDB.12.0"
  .Properties("Data Source") = ActiveWorkbook.FullName
  .Properties("Extended Properties") = "Excel 12.0 Xml;HDR=YES"
  .Open
End With

Ruta = Datos.Range("BP2") 'Actual
If Trim(Ruta) = Empty Then MsgBox "La ruta del archivo (Celda: BP2) del trimestre actual esta vacia!": Exit Sub
If Sifse.BuscarTexto(Ruta, Trimes & "T") = False Then MsgBox "Revisa que sea el archivo del " & Trimes & "T (Celda: BP2)!": Exit Sub

RutaTriAnt = Datos.Range("BQ2")
If Trimes <> 1 Then '***
    If Trim(RutaTriAnt) = Empty Then MsgBox "La ruta del archivo (Celda: BQ2) del trimestre anterior esta vacia!": Exit Sub
    If Sifse.BuscarTexto(RutaTriAnt, Trimes - 1 & "T") = False Then MsgBox "Revisa que sea el archivo del " & Trimes & "T (Celda: BQ2)!": Exit Sub
End If '***

Dim Pfi$, Pff$
Select Case Trimes
    Case 1: Pfi = "1/1": Pff = "31/3"
    Case 2: Pfi = "1/4": Pff = "30/6"
    Case 3: Pfi = "1/7": Pff = "30/9"
    Case 4: Pfi = "1/10": Pff = "31/12"
End Select

FIni = CDate(Pfi & "/" & Anio)
FFinal = CDate(Pff & "/" & Anio)

'-Abro el archivo
Set LibroDestino = Workbooks.Open(Ruta)
If Trimes <> 1 Then Set LibroTriAnt = Workbooks.Open(RutaTriAnt) '***

'Limpio el Libro Abierto
Workbooks(LibroDestino.Name).Activate

Dim i%, j%, FilD%, ColD%, SaldoAnt As Double, HojaA$ 'Saldoant: Saldo del libro del trime anterior, HojaA: Hoja del libro del libro del trime ant, FilD y Cold: Fila y col del libro y hoja Destino
Dim Q&, RutaBook$, RutaUtil$, Letra$, Filaformulas& 'Q: guarda el numero de columna
Dim FilT As Long, ColT As Long
Dim Tt As Single

Tt = Timer

With Workbooks(LibroDestino.Name)
    
    For i = 1 To Sheets.Count
        
        HojaA = Sheets(i).Name
        'Sheets(HojaA).Activate
        
        If Funciones.ExisteHoja(HojaA) = False Then MsgBox "La hoja: " & HojaA & "No exite", vbCritical: GoTo 1
        
        If Sheets(HojaA).Name = "EST SIT  FRA" Or Sheets(HojaA).Name = "TRABAJO" Then GoTo 1
        
        FilD = WorksheetFunction.Match("Fecha", Sheets(HojaA).Range("A:A"), 0)
        ColD = WorksheetFunction.Match("HABER", Sheets(HojaA).Range(FilD & ":" & FilD), 0)
        
        Filaformulas = Sheets(HojaA).Cells(Rows.Count, ColD).End(xlUp).Row
        
        If Filaformulas > 2000 Then Filaformulas = 290 'Si se pasa de las formulas que tome solo 290 filas
    
            If FilD = Empty Or FilD = 0 Or ColD = Empty Or ColD = 0 Then
                Set Datos = Nothing
                Set LibroDestino = Nothing
                Set RELACION = Nothing
                MsgBox "No existe Fecha, Debe en la Hoja " & HojaActual.Name, vbCritical, "Envio Trimestres"
                Exit Sub
            End If

        With Sheets(HojaA)
            .Range(.Cells(FilD + 1, 1), .Cells(Filaformulas - 1, ColD)) = "" 'Borra hasta donde esta la formula
            .Range(.Cells(FilD + 1, ColD + 1), .Cells(FilD + 1, ColD + 1)) = "" 'CelDa debajo de Saldo
        End With
        
        '------'Traemos los saldos-------Busco la fila y col de saldo
        If Trimes <> 1 Then '***
            Workbooks(LibroTriAnt.Name).Activate
            'Sheets(HojaA).Activate
        
            FilT = WorksheetFunction.Match("Fecha", Sheets(HojaA).Range("A:A"), 0)
            ColT = WorksheetFunction.Match("SALDO", Sheets(HojaA).Range(FilT & ":" & FilT), 0)
            
            Dim Ufila&
            Ufila = Sheets(HojaA).Cells(Rows.Count, 1).End(xlUp).Row '+ 1 '+1 Era para tomar la celda que seguia pero no toma el saldo xq la ultima celda debe sr la tiene datos
            
            'Si la fila y la col es = al texto SALDO---------
            If Not IsNumeric(Sheets(HojaA).Cells(Ufila, ColT).Value) Then
                SaldoAnt = Sheets(HojaA).Cells(Ufila + 1, ColT).Value '0
            Else
                SaldoAnt = Sheets(HojaA).Cells(Ufila, ColT).Value
            End If
            '-------
            Workbooks(LibroDestino.Name).Activate
            Workbooks(LibroDestino.Name).Sheets(HojaA).Cells(FilD + 1, ColD + 1) = SaldoAnt
        End If '***
1: Next i
'-----------
FilD = Empty: ColD = Empty: HojaA = Empty: Filaformulas = Empty
FilT = Empty: ColT = Empty

If Trimes <> 1 Then Workbooks(LibroTriAnt.Name).Close SaveChanges:=False '***

End With
End sub

Gracias de antemano.