Nombre de una hoja sea el valor de una Celda o varias
Tengo una interrogante, tengo un archivo Excel con muchas hojas de nombre de personas y deseo que cada Hoja tenga el nombre de la persona con una macro que sea automática.
Saludos y se agradece todo tipo de ayuda.
.14/09/16
Buenas tardes, Félix
El siguiente procedimiento hace lo que solicitas.
Pero además, permite que indiques alguna hoja que NO debe ser renombrada y controla que el nombre a asignar sea válido (caracteres especiales o nombres muy extensos o duplicados podrían hacer fracasar la tarea).
Accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:
Sub NombraHojas() '---- Variables modificables: '=== FELIX: Modifica estos datos de acuerdo a tu planilla: NombreEn = "D2" ' celda donde está el nombre a dar a la hoja Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse '---- fin Variables ' '---- inicio de rutina: ' For Each Hoja In Sheets If Hoja.Name <> Excluir Then NomHoja = Hoja.Range(NombreEn).Value On Error Resume Next Hoja.Name = NomHoja If Err <> 0 Then ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _ IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10) TipoMens = vbCritical ElTitulo = "NOMBRE INCOMPATIBLE!" MsgBox ElMensaje, TipoMens, ElTitulo GoTo TheEnd Else cont = cont + 1 End If Err.Clear On Error GoTo 0 End If Next TheEnd: ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Bien, nota que al principio de la rutina hay un par de variables para que le indiques de qué celda tomar el nombre y qué hoja quisieras que no se renombre...
.
Una cosa más si no es molestia. Debido a que la información me viene en la celda con la palabra Nombre escrito, tengo que hacer un extraer "=EXTRAE(A4, 9,40)" y pegarlo en todas las hojas para que la fórmula que me envió tome el valor de esta celda y por ultimo tengo que ponerlo en orden Alfabético ascendente.
Tendrá algo que sea más automático, y gracias por toda su ayuda. Es un pro en esto.
.
Hola, Félix
Te armé esta variante -porque no la tenía- que evita que tengas que modificar esas celdas manualmente.
La rutina contempla quitar lo que está delante del nombre y, una vez completado el proceso de renombrado de hojas, las ordena:
Sub NombraHojas() '---- Variables modificables: '=== FELIX: Modifica estos datos de acuerdo a tu planilla: NombreEn = "D2" ' celda donde está el nombre a dar a la hoja Quitar = "Nombre:" Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse '---- fin Variables ' '---- inicio de rutina: ' Application.ScreenUpdating = False For Each Hoja In Sheets If Hoja.Name <> Excluir Then NomHoja = Trim(Hoja.Range(NombreEn).Value) On Error Resume Next Hoja.Name = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar))) If Err <> 0 Then NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar))) ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _ IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10) TipoMens = vbCritical ElTitulo = "NOMBRE INCOMPATIBLE!" Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo GoTo TheEnd Else cont = cont + 1 End If Err.Clear On Error GoTo 0 End If Next 'Ordenamiento de hojas For Act = 1 To Sheets.Count - 1 For Sig = Act + 1 To Sheets.Count If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then Sheets(Sig).Move Before:=Sheets(Act) End If Next Sig Next Act TheEnd: ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", "")) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Espero que te satisfaga esta alternativa.
Saludos
Fernando
.
.
Buenas, de nuevo
Para acortar los nombres de la celda al máximo permitido de 31 caracteres, sólo tienes que agregar -en la macro- esta línea:
NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja)))
Reemplaza toda la rutina anterior por esta otra que ya la tiene agregada:
Sub NombraHojas() '---- Variables modificables: '=== FELIX: Modifica estos datos de acuerdo a tu planilla: NombreEn = "D2" ' celda donde está el nombre a dar a la hoja Quitar = "Nombre:" Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse '---- fin Variables ' '---- inicio de rutina: ' Application.ScreenUpdating = False For Each Hoja In Sheets If Hoja.Name <> Excluir Then NomHoja = Trim(Hoja.Range(NombreEn).Value) On Error Resume Next Hoja.Name = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar))) If Err <> 0 Then NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar))) NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja))) ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _ IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10) TipoMens = vbCritical ElTitulo = "NOMBRE INCOMPATIBLE!" Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo GoTo TheEnd Else cont = cont + 1 End If Err.Clear On Error GoTo 0 End If Next 'Ordenamiento de hojas For Act = 1 To Sheets.Count - 1 For Sig = Act + 1 To Sheets.Count If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then Sheets(Sig).Move Before:=Sheets(Act) End If Next Sig Next Act TheEnd: ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", "")) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Espero que así quede mejor aún.
Abrazo
Fer
.
Sigue sin gustarle el nombre.
.
Es extraño, porque probé con ese caso, recortado y lo tomó.
Prueba con esta rutina simple:
sub aaprobar() NomHoja = "CHRISTIAM Enrique Gonzalez Quiroz" NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja))) ActiveSheet.Name = NomHoja End Sub
El resultado será que la hoja quede como: CHRISTIAM Enrique Gonzalez Quir
Si no, es que hay otro problema.
Si Funciono con esa rutina.
Si tema va ser el largo porque también me pasa con otros nombres que son largos.
Alguna sugerencia ?
.
Hola!
La última rutina que te pasé era solo para probar que la solución de limitar los 31 caracteres funciona bien. No es para que la uses en todas las hojas.
Si te fijas, verás que es exactamente la misma instrucción que agregué dentro del procedimiento original. Por lo tanto debería funcionar para todas las hojas.
Por eso te comentaba que, tal vez, haya otro problema que interrumpa la rutina.
Si te volviera a suceder, envíame el nombre que debería usar y que detiene la ejecución de la rutina.
Saludos
Fernando
.
El otro Nombre Oscar Alejandro Van Horne Riva se detiene, cada vez que el nombre es largo me sale " no puede tomar el nombre ", y lo que hago es quitarle el ultimo apellido y funciona.
.
Buenas, Félix
La instrucción del límite de caracteres es correcta. El lugar donde la coloqué, no.
Por eso te envío esta variante que -hasta donde probé- funciona correctamente:
Sub NombraHojas() '---- Variables modificables: '=== FELIX: Modifica estos datos de acuerdo a tu planilla: NombreEn = "D2" ' celda donde está el nombre a dar a la hoja Quitar = "Nombre:" Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse '---- fin Variables ' '---- inicio de rutina: ' Application.ScreenUpdating = False For Each Hoja In Sheets If Hoja.Name <> Excluir Then NomHoja = Trim(Hoja.Range(NombreEn).Value) 'control de celda vacia: NomHoja = IIf(Len(NomHoja), NomHoja, Quitar) 'quita texto a la izquierda: NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar))) 'Limita nombres extensos NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja))) On Error Resume Next Hoja.Name = NomHoja If Err <> 0 Then ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _ IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10) TipoMens = vbCritical ElTitulo = "NOMBRE INCOMPATIBLE!" Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo GoTo TheEnd Else cont = cont + 1 End If Err.Clear On Error GoTo 0 End If Next 'Ordenamiento de hojas For Act = 1 To Sheets.Count - 1 For Sig = Act + 1 To Sheets.Count If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then Sheets(Sig).Move Before:=Sheets(Act) End If Next Sig Next Act TheEnd: ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", "")) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Espero que ahora si te funcione como corresponde. Mis disculpas.
Abrazo
Fernando
.
¡Gracias! Excelente.
Que Curso me sugieres para poder hacer todo esto, conozco pero lo básico.
.
Hay una serie de videos encadenados - se lo ve bastante didáctico- que te resumo con este vínculo:
https://www.youtube.com/playlist?list=PLF79C9D65E1EC4807
Si prefieres material escrito, de los que conozco, creo que este es de los más completos y bastante actualizado.
http://personales.upv.es/jpgarcia/LinkedDocuments/macrosVisualBasicParaExcel.pdf
Saludos nuevamente.
Fernando
.
