Como hacer para que esta macro funcione en 2 hojas y criando 2 como respaldo

Tengo este conjunto de macros que su función es crear una hoja como Copia y Sumar el %10 a tabla de determinada columna en hojas especificadas en las macros en mi caso es la columna D.

PROBÉ CAMBIANDO EL NOMBRE A LAS HOJAS sin resultado alguno

Private Sub Workbook_Open()
Dim UltFila As Integer
MESact = Format(Date, "mmmm-yyyy")   'PARA QUE COLOQUE EL NOMBRE DEL MES
UltFila = Sheets("Tabla2").Range("h" & Rows.Count).End(xlUp).Row       'CAMBIE NOMBRE A TABLA GENERAL Y A I
If Sheets("Tabla2").Range("h" & UltFila) = MESact Then        'CAMBIE DE H A I       'CAMBIE NOMBRE A TABLA GENERAL Y A I
Else
Sheets("Tabla2").Range("h" & UltFila + 1) = MESact       'CAMBIE NOMBRE A TABLA GENERAL Y A I
Call actualiza
End If
End Sub

Sub actualiza()
HOJA = "Tabla2"       'CAMBIE NOMBRE A TABLA GENERAL
Sheets(HOJA).Copy After:=Sheets(2)       'CAMBIE NOMBRE A Sheets(2)
ActiveSheet.Name = "Copia"       'CAMBIE NOMBRE A COPIA GENERAL
For I = 3 To 27    'LE AUMENTE EL RANGO A 57
    If I = 14 Or I = 15 Or I = 16 Or I = 17 Then         ' LA DESACTIVE
    Else        'LA DESACTIVE
        VALOR = Sheets(HOJA).Cells(I, 4).Value       'CAMBIE DE 4 A 2
        Sheets(HOJA).Cells(I, 4).Value = VALOR * 1.1       'CAMBIE DE 4 A 2
    End If        'DESACTIVE
Next I
Sheets(HOJA).Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia")      'CAMBIE NOMBRE A COPIA GENERAL
If wSheet Is Nothing Then
MsgBox ("La hoja Copia no existe")      'CAMBIE NOMBRE A COPIA GENERAL
Else 'Si existe la hoja Copia
MsgBox ("La hoja Copia existe para eliminar")      'CAMBIE NOMBRE A COPIA GENERAL
Sheets("Copia").Delete      'CAMBIE NOMBRE A COPIA GENERAL
End If
End Sub

¿Qué necesito?

Esta macro ejecute su función tal como lo esta haciendo y concebida, además también ejecute el mismo proceso en otra hoja. Su nombre "Tabla1" y crear hoja "Copia1" como crea la "Copia" de la Tabla2. El nombre del mes, en la columna I de la hoja Tabla1

En la Tabla1 En la columna B sume al actual el 10% y en la columna C 0.05%

La hoja Tabla1 no existen intervalos entre líneas como se ve en la imagen 2, en este momento va desde la línea 3 hasta la 57, mañana puede ir hasta la 60, pero eso no es problema por que siempre que agregue, le aumento el rango en la macro o entonces que la macro a crear pueda ir agregando y reconocido por la macro

De antemano Gracias por su ayuda. Alguna aclaratoria estoy a sus ordenes

No logro colocar enlace sin que este quede activo

1 respuesta

Respuesta
1

Con la aclaracíón de que sea 'TABLA GENERAL' voy a asumir que siempre será la hoja activa...

Si el libro tiene 1 sola hoja... perfecto, nada que aclarar.

Si el libro tiene más hojas y se abre desde alguna otra aplicación, primero hay que activar la hoja que se quiere trabajar.

El código en el objeto ThisWorkbook quedaría así: 

Private Sub Workbook_Open()
Dim UltFila As Integer
MESact = Format(Date, "mmmm-yyyy")                              'mes-año
UltFila = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row     'hoja activa, col I
If ActiveSheet.Range("I" & UltFila) <> MESact Then
    ActiveSheet.Range("I" & UltFila + 1) = MESact               'mes-año en primer fila libre, col I
    Call actualizaTabla1
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia_" & ActiveSheet.Name)    'verifica si se realizó la copia de hoja activa
If wSheet Is Nothing Then
    MsgBox ("La hoja " & wSheet.Name & " no existe")
Else                                                'Si existe la hoja Copia se la elimina
    MsgBox ("La hoja " & wSheet.Name & " existe para eliminar")
    wSheet.Delete                                   'elimina la copia creada en apertura
End If
End Sub

Y en un módulo la de actualización:

Sub actualizaTabla1()
'x Elsamatilde
HOJA = ActiveSheet.Name                         'se ejecuta sobre la hoja activa
Sheets(HOJA).Copy After:=Sheets(Sheets.Count)   'se guarda la copia al final de las hojas
ActiveSheet.Name = "Copia_" & HOJA              'la copia corresponde a la hoja activa
x = Range("A" & Rows.Count).End(xlUp).Row       'se establece el fin del rango
For I = 3 To x                                  'recorre la tabla hasta última fila ocupada
    VALOR = Sheets(HOJA).Cells(I, 2).Value      'en columna B acumula el 10%
    Sheets(HOJA).Cells(I, 2).Value = VALOR * 1.1
    VALOR = Sheets(HOJA).Cells(I, 3).Value      'en columna B acumula el 10%
    Sheets(HOJA).Cells(I, 3).Value = VALOR * 1.05
Next I
Sheets(HOJA).Select
End Sub

NOTA; cuando en una comparación POR IGUAL no hay nada para indicarle .. evaluar directamente por DISTINTO (<>)

If Sheets("Tabla2").Range("h" & UltFila) = MESact Then        
Else

A la macro del evento BeforeClose habría que agregarle una instrucción para evitar el mensaje de alerta. Te quedaría de este modo:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia_" & ActiveSheet.Name)    'verifica si se realizó la copia de hoja activa
MsgBox wSheet.Name
If wSheet Is Nothing Then
    MsgBox ("La hoja Copia no existe")
Else                                                'Si existe la hoja Copia se la elimina
    MsgBox ("La hoja Copia existe para eliminar")
    Application.DisplayAlerts = False               'evita el mensaje del delete de hoja
    wSheet.Delete                                   'elimina la copia creada en apertura
    Application.DisplayAlerts = True
End If
End Sub

Sdos!

Ups... mejor así

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia_" & ActiveSheet.Name)    'verifica si se realizó la copia de hoja activa
If wSheet Is Nothing Then
    MsgBox ("La hoja Copia no existe")
Else                                                'Si existe la hoja Copia se la elimina
    MsgBox ("La hoja Copia existe para eliminar")
    Application.DisplayAlerts = False               'evita el mensaje del delete de hoja
    wSheet.Delete                                   'elimina la copia creada en apertura
    Application.DisplayAlerts = True
End If
End Sub

Sdos!

Ohhhh... muy lunes por la mañana para responder en el foro... jajajaja

Esta es la correcta:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia_" & ActiveSheet.Name)    'verifica si se realizó la copia de hoja activa
If wSheet Is Nothing Then
    MsgBox ("La hoja " & wSheet.Name & " no existe")
Else                                                'Si existe la hoja Copia se la elimina
    MsgBox ("La hoja " & wSheet.Name & " existe para eliminar")
    Application.DisplayAlerts = False               'evita el mensaje de alerta
    wSheet.Delete                                   'elimina la copia creada en apertura
    Application.DisplayAlerts = True
End If
End Sub

Sdos!

Hola Elsa, mis saludos y gracias por la respuesta

El libro contien más hojas

Una de ellas es la hoja llamada Tabla2 y la otra hoja es llamada Tabla1

Al abrir por 1ª ves en el mes, la macro creará una hoja de respaldo de cada Tabla, ¿para qué? Poder comparar y luego se eliminan al cerrar el libro SI UNO QUIER ELIMINARLA, verifica bie nla macro que deje que es lo que hace, pero en ese entonces SOLO tenia la hoja Tabla2, ahora le agregue otra que es Tabla1 donde en la Tabla2 la tabla no es continua en tre rango y rango hay unas líneas que no entran en la ejecución de la suma del 10%.

En la Tabla1 si es continua, las imágenes lo muestran

Antes de la suma del 10% en la tabla2 y 0.05% en la Tabla1, la macro crea una hoja que es Copia para respaldo de la tabla2 y creará Copia1 de respaldo a la Tabla1

El libro puede tener varias hojas2, 4, 5, 8, 10, las que sean, pero solo actúa sobre las hojas mencionadas, Tabla2 y Tabla1.

La 1ª imagen es de la Tabla2 y la 2ª de la Tabla1

La idea es dentro de este conjunto de macros que deje en mi 1ª mensaje (q funciona a perfección) INCLUIR también la hoja Tabla1 y Copia1

La idea es dentro de este conjunto de macros que deje en mi 1ª mensaje (q funciona a perfección) INCLUIR también la hoja Tabla1 y Copia1

La idea es incluir también en este conjunto de macros (que deje al inicio) la hoja Tabla1 y Copia1, sin importar si están activas o no porque el caso se da en Private Sub Workbook_Open() y no se sabe cual hoja (si Tabla1 o Tabla2) va a estar activa

La idea es incluir también en este conjunto de macros (que deje al inicio) la hoja Tabla1 y Copia1, sin importar si están activas o no porque el caso se da en Private Sub Workbook_Open() y no se sabe cual hoja (si Tabla1 o Tabla2) va a estar activa

Que pena el cierre del foro en estos días... si aún no lo resolviste aquí va la nueva macro.

Sub actualizaTabla()
'x Elsamatilde
hoja = ActiveSheet.Name                         'se ejecuta sobre la hoja activa
Sheets(hoja).Copy After:=Sheets(Sheets.Count)   'se guarda la copia al final de las hojas
ActiveSheet.Name = "Copia_" & hoja              'la copia corresponde a la hoja activa
If ActiveSheet.Name = "Tabla1" Then
    x = Range("A" & Rows.Count).End(xlUp).Row       'se establece el fin del rango
    For I = 3 To x                                  'recorre la tabla hasta última fila ocupada
        VALOR = Sheets(hoja).Cells(I, 2).Value      'en columna B acumula el 10%
        Sheets(hoja).Cells(I, 2).Value = VALOR * 1.1
        VALOR = Sheets(hoja).Cells(I, 3).Value      'en columna C acumula el 0,5%
        Sheets(hoja).Cells(I, 3).Value = VALOR * 1.05
    Next I
ElseIf ActiveSheet.Name = "Tabla2" Then
    For I = 3 To 27
        If I = 14 Or I = 15 Or I = 16 Or I = 17 Then
        Else
            VALOR = Sheets(hoja).Cells(I, 4).Value
            Sheets(hoja).Cells(I, 4).Value = VALOR * 1.1    '10% en col D
        End If
    Next I
End If
End Sub

Se ejecuta sobre la hoja activa.... comparando si se trata de Tabla1 o Tabla2 (ajusta estos nombres). Y las copias se generan con ese nombre también. 

Sdos y no olvides valorar la respuesta.

Elsa

La copia1 no la cría y la copia2 la cría DESPUÉS de actualizar la Tabla2

La idea es que crie la Copia2 y Copia1 ANTES, antes de la actualización de los 10% y, 05% no solamente la copia2

Así como lo hace, no recuerdo el valor que tenia ANTES de criar la copia. Esta copia 1 y Copia2 son precisamente para que quede un respaldo de lo antes de actualizar

Al cerrar el libro SI QUIERO se elimina las copias 1 y 2 si no quiero se quedan, por eso la adevertencia MsgBox Else MsgBox si existe o no

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets("Copia")
If wSheet Is Nothing Then
MsgBox ("La hoja Copia no existe")
Else 'Si existe la hoja Copia
MsgBox ("La hoja Copia existe para eliminar")
Sheets("Copia").Delete
'Linea para crear Hoja
'Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Prueba"
End If
End Sub

Esa Copia que menciona es de la Tabla2 que vien a ser Copia2

En mi caso tiene que incluir también la Copia1 de la Tabla1

Gracias Elsa

Dame tu email y te envío el libro

Cibersoft. Arg de Gmail

Si tiene algunas claves por favor no te las olvides de enviármelas.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Encontrar datos no coincidentes excel

Sucede que tengo que comparar dos bases de datos y encontrar los elementos no coincidentes para analizar. Se puede hacer por fórmula pero necesito algo más optimizado. El otro problema es que los datos son más de 1.48.576 capacidad de líneas de...
1 respuesta

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
2 respuestas

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
3 respuestas

¿Cómo ajustar texto automáticamente en celdas combinadas en Excel 2019?

Solicito amablemente su valiosa ayuda para ajustar automáticamente un rango de celdas de una columna, he intentado con la opción de ajuste autamático de filas, también con al opción de ajustar texto de la pestaña inicio e incluso con la siguiente...
1 respuesta

¿Cómo usar un excel con macros desde varios ordenadores?

A tod@s! Tengo una aplicación en excel para introducir datos y visualizarlos con diferentes formularios creados. Lo que quiero hacer es: 1 Que ese libro este alojado en un sitio común y que lo puedan abrir desde varios ordenadores. 2º Que se pueda...
3 respuestas

Error en macro al ejecutar el botón aceptar

Necesitaría la colaboración para resolver el error que sucede al ejecutar el botón aceptar Set mifila = Hoja2.ListObjects(1).ListRows.Add Lo que yo agregue solamente a la base fue una columna al inicio ("A") anteriormente se llamaba Tabla6 y yo ahora...
1 respuesta

Detectar cambios en tabla dinámica

Tengo una hoja donde se van actualizando datos mediante una tabla dinámica. ¿Cómo detecto cuando se producen cambios (sólo en la parte de la tabla dinámica) para ejecutar otra macro en la misma hoja?
1 respuesta

Macro con combinación de teclas

Acudo aquí buscando ayuda, ¿Cómo crear una macro que genere una combinación de teclas? NO se trata de asignar una macro a una combinación de teclas, es todo lo contrario. El problema radica en que tengo una macro que rellena ciertas celdas con...
1 respuesta

Pasar datos de listbox a hoja con decimales

Como están estimados maestros y maestras, una vez mas solicitando vuestra experta ayuda. Tengo un formulario que busca datos entre 2 fechas desde 2 textbox, carga en listbox lo filtrado, en la columna 2 del listbox carga valores con formato de 2...
1 respuesta

Una macro que de aviso sobre vencimiento de una cedula de identidad

Tengo una hoja de calculo de 6 columnas en donde la columna A es fecha de vencimiento, las columnas B, C, y D son apellidos paterno, Materno u nombres, la columna E es el numero de cedula de identidad Con Formato ##.###.###-# la columna F es lo...
1 respuesta