Jump to content
SALAVERRINO

MACRO PARA ELIMINAR HOJAS

Recommended Posts

Buenas tardes a los integrantes de este foro, en esta ocasión recurro a Uds, con alguna macro que permita eliminar hojas de un archivo, de las cuales el archivo en mención cuenta con 10 hojas y de las cuales pretendo eliminar 8.

Desde ya agradezco su apoyo y colaboración.

Share this post


Link to post
Share on other sites
Hace 7 horas, SALAVERRINO dijo:

el archivo... cuenta con 10 hojas y de las cuales pretendo eliminar 8

en tanto comentas detalles más específicos, el siguiente es un procedimiento (ya viejito, sin bucles ni formularios PERO) que "apela" al buen criterio y sentido común del usuario, el truco es seleccionar desde el inputbox los números de las hojas correspondientes (para seleccionarlas agrupadas) utilizando una coma como separador (OJO: aun si se trata de hojas contiguas)

Sub AdministrarHojas(): Dim lista As String: On Error Resume Next
' procedimiento para seleccionar/eliminar 'determinadas' hojas ... ' _
  R&D: Héctor Miguel Orozco Díaz (febrero 16, 2009) '
  Names.Add "hojas", "=substitute(get.workbook(1),""[""&get.document(88)&""]"","""")"
  lista = InputBox("Indica el # de hoja separando por comas" & vbCr & vbCr & _
    Join(Evaluate("transpose(row(1:" & [counta(hojas)] & "))&char(9)&transpose(transpose(hojas))"), vbCr), _
    "Paso unico para administrar las hojas seleccionadas"): Names("hojas").Delete
  If lista = "" Then Exit Sub
  Sheets(Evaluate("{" & lista & "}")).Select
End Sub

una vez (com)probado que las hojas seleccionadas son las que elegiste, puedes cambiar el ".Select" por un ".Copy", o ".Delete" o ???

nota: si el libro contiene más de 20 hojas... (necesitarás de una pantalla alta o "trocear" el inputbox a más columnas o cambiar a un formulario de usuario ?)

las adecuaciones que se te puedan ocurrir para mejorar el procedimiento... (ya van por tu cuenta ?)

saludos,
hector.

Share this post


Link to post
Share on other sites

Buenos días Srs del foro, efectivamente omite el adjuntar el archivo de acuerdo a las normas del foro, para lo cual adjunto le link de archivo donde requiero eliminar las hojas que había solicitado en el mensaje lineas arriba descrita.

https://drive.google.com/file/d/1v74j2isZzQjObFq9vhf7Lb7gkTsrheWV/view?usp=sharing

NOTA:

La macro que contiene la instrucción es el Módulo 5, esta al final.

Sub ELIMINA_TODAS_MENOS_TODAS()
    Application.DisplayAlerts = False

Sheets(Array("EE", "TAB_JUDICIAL", "TABLA_AUXILIAR", "DATA", "HISTORICO", "PDT 601", "PDT 602", "AFP", "ONP", "TELECREDITO JUDICIAL", "DATOS", "DATOSS", "VENCIDO", "SORT", "NAVI")).Delete
    Application.DisplayAlerts = True
End Sub

pero cuando en la linea del Sheets(Array(dejo 6 nombres, si se realiza la macro, sin ningún problema)

Desde ya agradezco su apoyo y colaboración con lo solicitado.

Share this post


Link to post
Share on other sites

En estos caso, es conveniente comprobar los nombres antes de rendirse.

La hoja TABLA_AUXILIAR no existe, corrigiendo el nombre se arregla el problema,

Sub ELIMINA_TODAS_MENOS_TODAS()
Application.DisplayAlerts = False
Sheets(Array("EE", "TAB_JUDICIAL", "TAB_AUXILIAR", "DATA", _
             "HISTORICO", "PDT 601", "PDT 602", "AFP", "ONP", _
             "TELECREDITO JUDICIAL", "DATOS", "DATOSS", "VENCIDO", "SORT", "NAVI")).Delete
Application.DisplayAlerts = True
End Sub

 

Share this post


Link to post
Share on other sites
Guest Cacho R

Hola! Salaverrino. Lo más parecido a lo que tienes sería esto:

Sub Elimina_hojas()
Dim Vec, Elim, ws As Worksheet
'
Vec = Array("Uno", "Dos") ' Estas son las hojas que se mantienen.
'
ReDim Elim(0 To 0)
For Each ws In Worksheets
  If IsError(Application.Match(ws.Name, Vec, 0)) Then
    ReDim Preserve Elim(1 To 1 + UBound(Elim)): Elim(UBound(Elim)) = ws.Name
  End If
Next

Application.DisplayAlerts = False: On Error Resume Next
  Worksheets(Elim).Delete
On Error GoTo 0: Application.DisplayAlerts = True
End Sub

Saludos, Cacho R

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png