Ordenar datos de columnas B,C,D igual que la columna A
Yo tengo una lista en la columna A y lo que queria hacer es que la columna B, C y D se ordenasen como la columna A y que si el valor de la columna B no coincide con el de A deje el hueco en blanco.
Como ejemplo sería:
Antes de ordenar
Columna A Columna B Columna C Columna D
000 000 1 1
001 003 3 3
002 005 5 5
003
004
005
Eso es lo que tendría y al ordenar me quedase:
Columna A Columna B Columna C Columna D
000 000 1 1
001
002
003 003 3 3
004
005 005 5 5
1 respuesta
Usa esta macro
Sub ordenar_datos()
Set datos = Range("a1").CurrentRegion
With datos
.EntireColumn.AutoFit
filas = .Rows.Count: col = .Columns.Count
For i = 1 To filas
numero = .Cells(i, 1)
numero2 = .Cells(i, 2)
If numero = numero2 Or IsEmpty(numero2) = True Then GoTo siguiente
.Cells(i, 2). Resize(1, col - 1).Copy
fila = WorksheetFunction.Match(numero2, .Columns(1), 0)
.Cells(fila, 2).Resize(1, col - 1).PasteSpecial xlValues
.Cells(i, 2).Resize(1, col - 1).ClearContents
siguiente:
Next i
.Columns(2).NumberFormat = "000"
End With
End Sub
Hola. muchas gracias por su respuesta pero me da error al ejecutar la macro en el punto del cual adjunto captura de pantalla.
La pantalla no me dice nada más que hay un error y la línea, ¿qué numero de error marca?, ¿Y cómo tienes estructurada tu información?, sube una pantalla de tu información, probablemente hay un error en el acomodo de la hoja
Así la tengo
Y el listado de la columna A es más extenso.
En la imagen veras una fila coloreada en verde eso significa que ese numero no tiene un numero equivalente en la columna A por tanto te saldrá un error, modifique la macro para que te mande un mensaje cada que aparezca un error de este tipo y te señale coloree la fila para que puedas identificar más rápido la fila, si no quieres que te muestre el mensaje y solo te coloree borra las líneas que tengan un '*
Sub ordenar_datos()
Set datos = Range("a1").CurrentRegion
With datos
.EntireColumn.AutoFit
filas = .Rows.Count: col = .Columns.Count
For i = 1 To filas
numero = .Cells(i, 1)
numero2 = .Cells(i, 2)
If numero = numero2 Or IsEmpty(numero2) = True Then GoTo siguiente
.Cells(i, 2).Resize(1, col - 1).Copy
On Error Resume Next
fila = WorksheetFunction.Match(numero2, .Columns(1), 0)
If Err.Number > 0 Then '*
MsgBox ("registro " & numero2 & " no existe, aceptar para continuar"), vbCritical, "AVISO" '*
.Cells(i, 2).Resize(1, 3).Interior.ColorIndex = 4
GoTo siguiente '*
End If '*
On Error GoTo 0
.Cells(fila, 2).Resize(1, col - 1).PasteSpecial xlValues
.Cells(i, 2).Resize(1, col - 1).ClearContents
siguiente:
Next i
.Columns(2).NumberFormat = "000"
End With
End Sub
