Ordenar hojas.

Es cierto, no me ha sido fácil y estuve buscando una solución satisfactoria. De hecho, lo estuve estudiando el fin de semana (que, como sabes, no tengo acceso a Internet)
En realidad, me costó entender la idea de hojas que cambien su nombre porque se insertó una nueva. Me parece que no es muy conveniente.
De todos modos, soy muy respetuoso de las razones por las cuales los usuarios organizan sus archivos de determinada manera, simplemente porque desconozco la totalidad del funcionamiento de ellos.
(Me pregunto, por qué las hojas no tienen por nombre el dato que está en B3...)
Es así que llegué a esta solución, que asume que la celda B3 tiene un nombre único (de todos modos, la macro avisará si encuentra tal problema).
Conceptualmente, funcionan tres macros:
Una, Renombre cada hoja con el nombre en la celda B3 (esta controla que no halla nombres duplicados)
Luego, una segunda macro ordena alfabéticamente las hojas. Aquellas que no tengan valor se agrupan al final del libro.
Finalmente una tercera, remunera las hojas y aquellas que tengan algún nombre en B3 reciben el numero de hoja en A3.
Estas tres macros están engarzadas en la macro "Reordena". Pega, entonces, el siguiente set de procesimientos en un módulo de BVA:
Public Erro As Boolean
Sub Reordena()
Erro = False
RenombraH
If Erro Then Exit Sub
OrdenaH
NumeraH
End Sub
Private Sub RenombraH()
'1º Renombra Hojas por su nombre real
On Error GoTo ErrHandler
For HojaAct = Sheets.Count To 1 Step -1
If Len(Sheets(HojaAct).Range("B3").Value) > 0 Then
NombHoja = Sheets(HojaAct).Range("B3").Value
Else
NombHoja = "ZZZ" & Trim(HojaAct)
End If
Sheets(HojaAct).Name = NombHoja
Next
On Error GoTo 0
Exit Sub
ErrHandler:
Sheets(HojaAct).Select
If Err.Number = 1004 Then
MsgBox "Existe algún problema con el nombre" & Chr(10) & "Macro detiene aquí su ejecución", vbCritical, "No es posible ubicar hoja"
Else
MsgBox Err.Number & ": " & Err.Description
End If
Erro = True
Err.Clear
On Error GoTo 0
NumeraH
Exit Sub
On Error GoTo 0
End Sub
Private Sub OrdenaH()
'2º Reordena Hojas Según nombre
Dim I As Integer, J As Integer
For I = 1 To Sheets.Count - 1
For J = I + 1 To Sheets.Count
If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then
Sheets(J).Move Before:=Sheets(I)
End If
Next J
Next I
End Sub
Private Sub NumeraH()
'3º Renumera las hojas según su posición
For HojaAct = Sheets.Count To 1 Step -1
Sheets(HojaAct).Name = HojaAct
If Len(Sheets(HojaAct).Range("B3").Value) > 0 Then
Sheets(HojaAct).Range("A3").Value = Sheets(HojaAct).Name
Else
Sheets(HojaAct).Range("A3").ClearContents
End If
Next
End Sub
---
Espero que sea lo que buscas.
Un abrazo!
Fernando

Admirado Experto:
Si mi cuestión ha resultado difícil y estas trabajando en la respuesta, perdóname y sigue sin prisa trabajando en ella.
Si no te ha llegado mi pregunta por favor, házmelo saber([email protected]).
Si te has olvidado por el acumulo de preguntas que te hemos hecho, recordarte que sigo esperando tu respuesta que me es crucial para poder terminar mi trabajo.
Saludos.