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