Agregar una nueva hoja más en este conjunto de macros

1 post / 0 nuevos
JoaoM
Imagen de JoaoM
Offline
última acción: Hace 2 semanas 2 días
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 15/12/2011 - 23:46
Puntos: 2870
Agregar una nueva hoja más en este conjunto de macros

 Agradezco su valiosa ayuda en este libro que tengo para sumar un porcentaje a los valores en determinada columna

 

Tal como menciono en el titulo; incluir a la macro, una nueva hoja más, llamada Tabla1


Además de hacer para lo que están programadas las macros agregar para una hoja más llamada Tabla1

 

Que la macro se ejecute sobre la hoja Tabla1 también tal como lo hace con Tabla2, que; en la hoja Tabla2 escribe el nombre del mes en la columna H, en la hoja Tabla1 escribirá el nombre del mes en la columna I


La Tabla 2 es interrumpida más o menos a la mitad y la hoja Tabla1 es corrida y puede ser variable su cantidad de líneas


Como se puede ver en el libro mismo

 

En Tabla2 los porcentajes a sumar actúan sobre la columna D y en la nueva hoja (Tabla1) será sobre las columnas B y C; en B 10% y en C 5%


Al abrir el libro por 1ª vez en el mes, coloca el nombre del mes en la columna H de la Tabla2 que haga lo mismo en la columna I de la Tabla1


El conjunto de macros involucradas


Private Sub Workbook_Open()
Dim UltFila As Integer
MESact = Format(Date, "mmmm-yyyy")
UltFila = Sheets("Tabla2").Range("h" & Rows.Count).End(xlUp).Row
If Sheets("Tabla2").Range("h" & UltFila) = MESact Then
Else
Sheets("Tabla2").Range("h" & UltFila + 1) = MESact
Call actualiza
End If
End Sub
Sub actualiza()
HOJA = "Tabla2"
Sheets(HOJA).Copy After:=Sheets(2)
ActiveSheet.Name = "Copia"
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
    End If
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")
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
End If
End Sub
AdjuntoTamaño
File Libro Lista32.81 KB

Etiquetas: