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