Macro para copiar rangos validados de hojas creadas en hoja resumen

Expertos, recurro a Uds. Para que me ayuden con la macro que quiero concluir. Las condiciones y requerimientos, son las siguientes:

1.- Se tiene una hoja INPUT, el rango de interés, es B6:B14, este rango no es fijo, comienza en B6 y la última celda es variable en la columna B; los datos son de este tipo: Z-1, Z-2, ..., Z-9

2.- Se tiene la hoja molde Z-0

3.- Se requiere una macro que copie la hoja Z-0, para cada celda del rango B6:B14 de la hoja INPUT, y que a cada hoja le asigne el nombre Z-1, Z-2, ..., Z-9; según el valor de cada celda del rango B6:B14

4.- Se requiere copiar, por cada hoja creada, los datos del rango: L83:L3351 si es que su correspondiente en M83:M3351 es igual a 1, en B4 de la hoja SCRIPT existente, apilando uno debajo de otro

5.- Se requiere que los datos apilados desde B4 hacia abajo, en la hoja SCRIPT, se guarde en un bloc de notas con el mismo nombre del archivo excel, con extensión: *. SCR y que se guarde en la misma ubicación del archivo excel.

Mis conocimientos en programación son básicos, por lo pronto, pude armar el código hasta el paso 3 (crear hojas según el rango B6:B14 y nombrarlas según el valor de dichas celdas), y se los muestro:

Sub CREAR_HOJAS_Y_ALMACENAR_DATA()
Dim Lista As Range
Dim iX As Long

On Error GoTo Cancelar

Set Lista = Application.InputBox(prompt:="Rango de zapatas a dibujar", _
Title:="Lista de Zapatas a dibujar", Type:=8)

Application.ScreenUpdating = False

For iX = Lista.Count To 1 Step -1
If Verifica_si_hoja_existe(Lista(iX)) = False Then
Sheets("Z-0").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = Lista(iX)
End If
Next iX

Sheets("Hoja1").Activate

Application.ScreenUpdating = True

Cancelar:
End Sub
Function Verifica_si_hoja_existe(sheetName As String) As Boolean

Dim wkb As Worksheet

On Error Resume Next
Set wkb = Sheets(sheetName)
On Error GoTo 0

Verifica_si_hoja_existe = IIf(Not wkb Is Nothing, True, False)
End Function

Añade tu respuesta

Haz clic para o