ExcelMacroCreateSheets.vb

' ExcelMacroCreateSheets, sgrodnik, v5, 2024/09/03
' Descripcion: https://gist.github.com/sgrodnik/9844035b4a6970ec126c8db80b146bf4

Sub CreateSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim newSheetName As String
    Dim rowCount As Long
    Dim lastRow As Long
    Dim i As Long
    Dim sheetExists As Boolean
    Dim startRow As Long
    Dim endRow As Long
    Dim ws As Worksheet
    Dim originalSheet As Worksheet

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set wsList = ThisWorkbook.Sheets("Base")
    Set wsTemplate = ThisWorkbook.Sheets("Template")
    Set originalSheet = ThisWorkbook.ActiveSheet

    lastRow = wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        newSheetName = wsList.Cells(i, 1).Value
        rowCount = wsList.Cells(i, 3).Value

        If wsList.Cells(i, 5).Value = "skip" Then
            GoTo SkipSheet
        End If

        If rowCount <= 1 Then
            GoTo SkipSheet
        End If

        sheetExists = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = newSheetName Then
                sheetExists = True
                Exit For
            End If
        Next ws

        If sheetExists Then
            Application.DisplayAlerts = False
            ThisWorkbook.Sheets(newSheetName).Delete
            Application.DisplayAlerts = True
        End If

        wsTemplate.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ActiveSheet.Name = newSheetName

        startRow = 12 + rowCount
        endRow = 51 + 11

        Range("A10").Value = rowCount

        ActiveSheet.Rows(startRow & ":" & endRow).Delete

SkipSheet:
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    originalSheet.Activate
    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


Sub DeleteSheetsExceptRange()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ws As Worksheet
    Dim rng As Range
    Dim delSheet As Worksheet
    Dim found As Boolean

    ' Set the range of sheets to keep
    Set rng = ThisWorkbook.Sheets("Base").Range("T5:T50")

    ' Loop through all sheets in the workbook
    For Each ws In ThisWorkbook.Sheets
        found = False

        ' Check if the sheet name is in the range
        For Each cell In rng
            If cell.Value = ws.Name Then
                found = True
                Exit For
            End If
        Next cell

        ' If the sheet name was not found in the range, delete the sheet
        If Not found Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Descripción en español

Este macro de Excel crea nuevas hojas basadas en datos de la hoja "Base" y una plantilla de la hoja "Template". Si ya existe una hoja con el mismo nombre, se eliminará y se reemplazará por la nueva. El script también elimina ciertas filas de la nueva hoja según los valores en los datos de origen.

Description in English

This Excel macro creates new sheets based on data from the "Base" sheet and a template from the "Template" sheet. If a sheet with the same name already exists, it will be deleted and replaced with the new one.

Instrucciones para ejecutar el código

1. Abra Excel.
2. Presione ALT + F11 para abrir el Editor de Visual Basic para Aplicaciones (VBA).
3. En el editor, inserte un nuevo módulo:
   Vaya a Insertar > Módulo.
4. Copie y pegue el código proporcionado en el módulo recién creado.
5. Cierre el Editor de VBA y vuelva a Excel.
6. Seleccione una celda que contenga texto en su hoja de cálculo.
7. Asegúrese de tener un documento de Word abierto.
8. Presione ALT + F8 para abrir la ventana Macros.
9. Seleccione CreateSheets y haga clic en Ejecutar.