Enviar datos a otra columna sin duplicados,
Resulta que en una columna tengo estos datos así (solo pondré 10 datos pero en realidad son 300)
1
2
4
6
1
7
8
9
4
1
Ahora quiero enviar estos datos a otra columna pero no en la misma pestaña de excel, si no que en otra pestaña, pero sin que se dupliquen los datos que me quede así.
1
2
4
6
7
8
9
Sin que se borre la original, en la original no quiero realizar nada, es decir ni tampoco ordenar en la original.
Solo la siguiente pestaña. Que me aparezca sin duplicaciones.
Se podría hacer con fórmulas normales o con macros. Ayuda por favor
1
2
4
6
1
7
8
9
4
1
Ahora quiero enviar estos datos a otra columna pero no en la misma pestaña de excel, si no que en otra pestaña, pero sin que se dupliquen los datos que me quede así.
1
2
4
6
7
8
9
Sin que se borre la original, en la original no quiero realizar nada, es decir ni tampoco ordenar en la original.
Solo la siguiente pestaña. Que me aparezca sin duplicaciones.
Se podría hacer con fórmulas normales o con macros. Ayuda por favor
{"lat":26.4312280645064,"lng":-101.25}
2 respuestas
Respuesta de Enrique Bernal
1
Esta macro deberías adaptarla a tu información, si resuelve tu pregunta no olvides de finalizar la pregunta
Sub Copiar_Pegar_Ordenar_BorrarIguales()
Sheets("2").Select 'Yo he llamado a la hoja 2, tendrias que cambiar por el nombre de tu hoja
' Esta parte escoge todo lo que este lleno desde la fila A1 Hasta el final y lo pega en D
Sheets("Copia").Select -----Esta es la hoja en la que vas a copiar la info
Range("A1").Value = "Nombre"
Sheets("Copia").Select -----Este es el archivo en el que esta la info
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Copia").Select
Range("A2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Range("A1:A65000").Select
Range("A1:A65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1" _
), Unique:=True
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
ActiveWorkbook.Worksheets("Copia").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Copia").Sort.SortFields.Add Key:=Range("D2:D65000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Copia").Sort
.SetRange Range("A2:A65000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub Copiar_Pegar_Ordenar_BorrarIguales()
Sheets("2").Select 'Yo he llamado a la hoja 2, tendrias que cambiar por el nombre de tu hoja
' Esta parte escoge todo lo que este lleno desde la fila A1 Hasta el final y lo pega en D
Sheets("Copia").Select -----Esta es la hoja en la que vas a copiar la info
Range("A1").Value = "Nombre"
Sheets("Copia").Select -----Este es el archivo en el que esta la info
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Copia").Select
Range("A2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Range("A1:A65000").Select
Range("A1:A65000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1" _
), Unique:=True
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
ActiveWorkbook.Worksheets("Copia").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Copia").Sort.SortFields.Add Key:=Range("D2:D65000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Copia").Sort
.SetRange Range("A2:A65000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Respuesta de James Bond
Prueba esta macro, suponiendo que tus datos están en la columna A y que quieres copiar los datos a la hoja2, esta macro lo hace dejando intactos los datos originales
Sub copiar_duplicados()
Dim unicos As New Collection
Set h2 = Worksheets("hoja2")
Set datos = Range("a1").CurrentRegion
With datos
Set destino = h2.Range("a1").Resize(.Rows.Count, .Columns.Count)
matriz = destino
x = 1
For i = 1 To .Rows.Count
numero = .Cells(i, 1)
On Error Resume Next
unicos.Add numero, CStr(numero)
If Err.Number = 0 Then matriz(x, 1) = numero: x = x + 1
On Error GoTo 0
Next i
End With
With destino
h2.Range(.Address) = matriz
.Sort key1:=h2.Range(.Columns(1).Address), order1:=xlAscending
End With
set unicos=nothing, set matriz=nothing: set datos=nothing
set destino=nothing
End Sub