Una Macro no me agrupa todos los datos que se han entrado
Buenos días,
Tengo un libro con dos hojas; la hoja0 donde hay 91 entradas/datos y em la hoja1 se ejecutan 3 macros. Las dos primeras( que se llaman proceso y agrupaItin) funcionan perfectamente y me agrupan los datos según lo requerido pero la tercera macro que se llama "listanombres" solo me ordena y agrupa 62 datos de los 91 que debería agrupar. No se que puede pasar porque en otro libro la misma macro funciona perfectamente. Por favor, si alguien puede ayudarme lo agradezco porque me urge para las matriculaciones del nuevo curso escolar. Adjunto el enlace con el libro en cuestión. Gracias. J
La macro funciona correctamente, una de las tareas de la macro es eliminar los duplicados de las agrupaciones que realizó, es por eso que solamente ves 62 datos, pero si quieres ver todos los datos, incluyendo los duplicados entonces utiliza esta macro actualizada.
Option Explicit
Sub ListaNombres()
'x Elsamatilde
Dim col1 As Integer, col2 As Integer, colx As Integer
Dim finx As Long, filx As Long
Dim dato As String
Dim espa As Byte, i As Byte
'la 1er columna de destino será BA (col 53) y fila 2
colx = 53
filx = 2
Application.ScreenUpdating = False
'Hoja1. Se recorre la fila 1 agrupando según título hasta el 1er espacio (IT1, ITA1, etc)
Sheets("Hoja1").Select
Columns("BA:BZ").ClearContents
Range("A1").Select
'busco el rango de col para cada grupo
col1 = 1
'recorre la fila 1 hasta encontrar celda vacía. fin de rango
While ActiveCell <> ""
espa = InStr(1, ActiveCell.Value, " ")
'el dato en común se encuentra hasta el 1er espacio
dato = Left(ActiveCell, espa)
'paso a cl sgte comparando contenido
While Left(ActiveCell, espa) = dato
ActiveCell.Offset(0, 1).Select
Wend
col2 = ActiveCell.Column - 1
'coloco el título del grupo
Cells(1, colx) = dato
'por cada col del rango, copio filas ocupadas en col destino
For i = col1 To col2
finx = Cells(65000, i).End(xlUp).Row
'copia datos a partir de fila 2
If finx >= 2 Then
Range(Cells(2, i), Cells(finx, i)).Copy Destination:=Cells(filx, colx)
'guardo la última fila ocupada en la col destino
filx = Cells(65000, colx).End(xlUp).Row + 1
End If
Next i
'terminó con un grupo, quita duplicados y ordena
Columns(colx).Select
filx = Cells(65000, colx).End(xlUp).Row
'ActiveSheet.Range(Cells(1, colx), Cells(filx, colx)).RemoveDuplicates Columns:=1, Header:=xlYes
ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(Cells(2, colx), Cells(filx, colx)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("hoja1").Sort
.SetRange Range(Cells(1, colx), Cells(filx, colx))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells(1, colx).Select
'sigue con el sgte grupo e incremente 1 col de destino
colx = colx + 1
filx = 2
col1 = col2 + 1
Cells(1, col1).Select
Wend
MsgBox "Fin del proceso", , "FIN"
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
No se que has cambiado pero ahora me salen los 91 datos correctos. No estaban duplicados, son nombres propios de alumnos de mi centro y cada uno era distinto. No se a que te refieres cuando dices duplicados. He borrado la anterior macro y he puesto la tuya y han aparecido 29 nombres que no aprecian antes. La verdad es que me gustaría enterarme de lo que has cambiado, más que nada porque he mrado y no lo veo. No se que pudiste cambiar. De todas formas un millón de gracias
Solamente comenté esta línea para que ya no borrar información
'ActiveSheet.Range(Cells(1, colx), Cells(filx, colx)).RemoveDuplicates Columns:=1, Header:=xlYes
