Dividir Hojas con el mismo rango de nombre en un libro de trabajo de Excel – Excel VBA

Answer

1. 

   davy.ai

   May 27, 2023 at 11:10 pm

   Para lograr la tarea de dividir y fusionar nombres de hojas específicas con VBA, puede utilizar el siguiente código:

   Sub DividirFusionarHojas()
       Dim srcWB As Workbook, tgtWB As Workbook
       Dim srcSheet As Worksheet, tgtSheet As Worksheet
       Dim srcSheetName As String, tgtSheetName As String
       Dim fileSavePath As String
       Dim counter As Integer
   
       Application.ScreenUpdating = False
   
       Set srcWB = ActiveWorkbook
       fileSavePath = Application.GetSaveAsFilename("Ubicación para guardar", "Libro de Excel (*.xlsx), *.xlsx")
       Set tgtWB = Workbooks.Add
   
       For Each srcSheet In srcWB.Worksheets
           srcSheetName = srcSheet.Name
   
           Select Case True
           Case InStr(1, srcSheetName, "Speclist") > 0
               counter = counter + 1
               If counter = 1 Then
                   Set tgtSheet = tgtWB.Sheets.Add(after:=tgtWB.Sheets(tgtWB.Sheets.Count))
                   tgtSheetName = srcSheetName
                   srcSheet.Copy after:=tgtSheet
                   tgtSheet.Name = tgtSheetName
               Else
                   srcSheet.Copy after:=tgtSheet
               End If
           Case InStr(1, srcSheetName, "Featurelist") > 0
               If InStr(1, srcSheetName, Mid$(tgtSheetName, 1, Len(tgtSheetName) - 8)) > 0 Then 'match speclist name
                   srcSheet.Copy after:=tgtSheet
               Else 'create new sheet
                   Set tgtSheet = tgtWB.Sheets.Add(after:=tgtWB.Sheets(tgtWB.Sheets.Count))
                   tgtSheetName = Left$(srcSheetName, Len(srcSheetName) - 11) 'trim "Featurelist"
                   srcSheet.Copy after:=tgtSheet
                   tgtSheet.Name = tgtSheetName
               End If
           Case InStr(1, srcSheetName, "Corelist") > 0
               If InStr(1, srcSheetName, Mid$(tgtSheetName, 1, Len(tgtSheetName) - 7)) > 0 Then 'match speclist name
                   srcSheet.Copy after:=tgtSheet
               Else 'create new sheet
                   Set tgtSheet = tgtWB.Sheets.Add(after:=tgtWB.Sheets(tgtWB.Sheets.Count))
                   tgtSheetName = Left$(srcSheetName, Len(srcSheetName) - 8) 'trim "Corelist"
                   srcSheet.Copy after:=tgtSheet
                   tgtSheet.Name = tgtSheetName
               End If
           End Select
       Next
   
       Application.DisplayAlerts = False
       srcWB.Close savechanges:=False
       tgtWB.SaveAs Filename:=fileSavePath, FileFormat:=51
       tgtWB.Close SaveChanges:=True
   
       Application.ScreenUpdating = True
   End Sub
   

   Este código iterará a través de todas las hojas en el libro de Excel activo y las dividirá en múltiples hojas en un nuevo libro en función de convenciones de nomenclatura específicas. También fusionará las hojas con el mismo nombre “speclist” en la misma hoja del nuevo libro. Luego, se guardará el libro de Excel resultante en una ubicación especificada.

   Para utilizar este código, simplemente abra el libro de Excel con las hojas que desea dividir/fusionar y ejecute la macro DividirFusionarHojas(). El libro resultante se guardará en una ubicación de su elección.

   Nota: Este código supone que los nombres de las hojas siguen la convención de nomenclatura especificada en la pregunta original, donde el nombre “speclist” se utiliza como prefijo para los demás nombres de las hojas. Si sus nombres de hoja no siguen esta convención, deberá modificar el código en consecuencia.

Comments are closed.