O lo que es lo mismo:
[code:1]Sub SeparaNombres()
' Separa Nombres con división \"/\" en columnas con encabezado
' Posicionarse en la primera celda a separar
' Macro recorded 02/10/2004 ByPaco
' actualizada el 01/09/2005 daba error si los datos estaban al tope superior de la hoja
' 22/08/2006 Se agregó la opción para poder elegir un separador
' adecuaciones 10-Sep-2007
'Solicita un separador
Sepa = InputBox(\"Escriba aquí el tipo de separador que usa para distinguir Nombres de apellidos\", \"Separador de Nombres\", \"/\"«»)
If Sepa = \" \" Or Sepa = \"\" Or Sepa = \" \" Then msg = MsgBox(\"No se permiten espacios com separador\", vbOKOnly, \"¡¡ A T E N C I Ó N !!\"«»)
If msg = vbOK Then GoTo fin 'Si el separador es un espacio o no pone nada termina el proceso
If Cells(ActiveCell.Row, ActiveCell.Column).Value = Empty Then GoTo fin
'Insera tres columnas una para nombre(s) y dos para los apellidos
ActiveCell.Range(\"A1:C1\"«»).EntireColumn.Insert
Cells(ActiveCell.Row, ActiveCell.Column + 3).Select 'Se posiciona en la primera celda despues de las columnas insertadas
Range(Selection, Selection.End(xlDown)).Select 'Selecciona toda la cadena de filas
'Realiza la separación
Selection.TextToColumns Destination:=Cells(ActiveCell.Row, ActiveCell.Column - 3), _
Other:=True, OtherChar:=Sepa, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
Selection.EntireColumn.Delete 'Borra la última columna
On Error GoTo Ins 'si causa error por no tener vacia la celda superior, inserta una
ActiveCell.Offset(-1, 0).Range(\"A1\"«»).Select
Ins:
If Err = 1004 Then
Selection.End(xlUp).Select
Selection.EntireRow.Insert
Cells(ActiveCell.Row, ActiveCell.Column).Select
End If
'Pone los encabezados de las columnas
On Error Resume Next
ActiveCell.Offset(0, -3).Range(\"A1\"«»).FormulaR1C1 = InputBox(\"Primer encabezado, normalmente apellido paterno\", \"Encabezado\", \"Ap.Paterno\"«») 'Select
ActiveCell.Offset(0, -2).Range(\"A1\"«»).FormulaR1C1 = InputBox(\"Segundo encabezado, normalmente apellido materno\", \"Encabezado\", \"Ap.Materno\"«») 'Select
ActiveCell.Offset(0, -1).Range(\"A1\"«»).FormulaR1C1 = InputBox(\"Tercer encabezado, normalmente nombre(s)\", \"Encabezado\", \"Nombre(s)\"«») 'Select
'Ajusta las columnas
ActiveCell.CurrentRegion.Columns.AutoFit
'Termina el proceso
fin:
End Sub
[/code:1]
Que raro, tal vez al copiar y pegar se modifica
pero aquí está un archivo<br><br>Mensaje editado por: ByPaco, el: 07/01/2008 12:20