Como hacer que me conserve el valor una variable excel

Hola Narvather,
El tema es el siguiente tengo el siguiente código:
Public Sub aid_Click() '-----Evento del boton IR---'
Set foundcell1 = ActiveSheet.Cells.Find(CDate(FECHA))   '---busca en la hoja actual----'
If foundcell1 Is Nothing Then   '---No encontro valor---'
    segui = MsgBox("¡No se encontró el valor en la hoja Actual!" + Chr(13) + "¿Desea continuar la busqueda en las Hojas Siguientes?", vbYesNo)
    If segui = vbYes Then
        For X = 2 To ActiveWorkbook.Worksheets.Count
        Worksheets(X).Select
            Set foundcell = ActiveSheet.Cells.Find(CDate(FECHA))
                If foundcell Is Nothing Then    '---------No encontró valor Buscado--------'
                    GoTo Finalsheets
                    End
                Else
                    Call encontradoHjsiguientes
                    MsgBox "La Proceso ha finalizado"
                    End
                End If
Finalsheets:
        Next X      'Sentencia que termina el proceso-----'
    Else
        End
        GoTo Finalsheets
    End If
Else    '-------Encontró valor buscado---------------'
            Call encontradoHjActual
            End
            MsgBox "La Proceso ha finalizado"
End If
MsgBox "La Proceso ha finalizado"
End Sub--------
Sub abri()
    carga = MsgBox("Ahora aguarde unos instantes mientras los datos" + Chr(13) + "se cargan automáticamente en el Archivo de Control de Comunicaciones", vbOKOnly, "CARGANDO POR FAVOR ESPERE")
If carga = vbOK Then
    Workbooks.Open ("J:\Dimensionamiento\Gestión Real\En Armado\Desconexiones\Control Comunicaciones y Desconexiones.xls")
    Windows("Control Comunicaciones y Desconexiones.xls").Activate
    Range("B5").Activate
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Activate
    Loop
        ActiveCell.Value = FECHA.Value
            ActiveCell.Offset(0, 1).Activate
        ActiveCell.Value = Inicial.Value
            ActiveCell.Offset(0, 1).Activate
        ActiveCell.Value = Final.Value
        ActiveCell.Offset(0, 1).Activate
    If ID1.Value = True Then
        ActiveCell.Value = A1.Value
    Else
        If ID2.Value = True Then
            ActiveCell.Value = A2.Value
        Else
            If ID3.Value = True Then
                ActiveCell.Value = A3.Value
                    If ID4.Value = True Then
                        ActiveCell.Value = A4.Value
                            If ID5.Value = True Then
                                ActiveCell.Value = A5.Value
                                    If ID6.Value = True Then
                                        ActiveCell.Value = A6.Value
                                            If ID7.Value = True Then
                                                ActiveCell.Value = A7.Value
                                                    If ID8.Value = True Then
                                                        ActiveCell.Value = A8.Value
                                                            If ID9.Value = True...