05/Sep/05 18:51
Re: SeparaNombres
Claro que si Gabriel (Saludos) con mucho gusto, es esta nueva versión corregida y aumentada :D se soluciona el error que le causaba a Blanca por no tener vacia la primera fila, además agregué la opción de cambiar el nombre de los encabezados:
[code:1:0beedd23d6]Sub SeparaNombres()
' Separa Nombres con división "/" en columnas con encabezado
' Macro recorded 05/09/2005 ByPaco
' Posicionarse en la primera celda a separar
If Cells(ActiveCell.Row, ActiveCell.Column).Value = Empty Then GoTo fin
ActiveCell.EntireColumn.Insert
ActiveCell.EntireColumn.Insert
ActiveCell.EntireColumn.Insert
Cells(ActiveCell.Row, ActiveCell.Column + 3).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Cells(ActiveCell.Row, ActiveCell.Column - 3), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
Selection.EntireColumn.Delete
'si causa error por no tener vacia la celda superior, inserta una
On Error GoTo Ins
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
On Error Resume Next
ActiveCell.Offset(0, -3).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("Primer encabezado, normalmente apellido paterno", "Encabezado", "Ap.Paterno")
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("Segundo encabezado, normalmente apellido materno", "Encabezado", "Ap.Materno")
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("Tercer encabezado, normalmente nombre(s)", "Encabezado", "Nombre(s)")
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
fin:
End Sub
[/code:1:0beedd23d6]
Espero y les funcione a todos, si no avisenme y trataré de corregirlo lo más pronto posible
«Antes que cambien los reinos, los hombres deberán cambiar»
═╬═
