Copiar parte de los registros de una columna a columna
Podrían ayudar con código de macros... Que pueda copiar parte de los registros de una columna a otra columna de la misma hoja de trabajo ... Como se ve en el siguiente ejemplo
debiendo que dar como se en el el siguiente imagen
dejo el archivo para verlo: https://docs.google.com/spreadsheets/d/1Q8MnRmhBqPC_nu4u-4JeUNx6t88U-jYC/edit?usp=sharing&ouid=109258364453015021448&rtpof=true&sd=true
2 respuestas
Te dejo la macro que solicitas.
Entra al Editor de macros (desde menú Programador/Desarrollador o con el atajo ALT +F11)
Inserta un módulo y allí pega el siguiente código:
Sub ajusteHoja()
'x Elsamatilde
Application.ScreenUpdating = False
'se quitan posibles filtros
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
'Se trabaja en hoja activa, a partir de fila 2 hasta la última según col E
x = Range("E" & Rows.Count).End(xlUp).Row
'se agrega una col delante de F para la fecha
Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'se recorren las filas
For i = 3 To x
'se copia el contenido de la col E en la F de la fila anterior
Range("E" & i).Copy Destination:=Range("F" & i - 1)
'se elimina la fila activa, restando 1 a la variable de fin de rango
Range("E" & i).EntireRow.Delete xlUp
x = x - 1
Next i
MsgBox "Fin del proceso.", , "Información"
End SubCada línea va explicada por lo que no tendrás inconvenientes en comprender el código.
Como es posible que el proceso se demore unos segundos, espera al mensaje de finalizado antes de realizar cualquier acción o cambio de hojas.
Puedo enviarte el libro con la macro ya ejecutada, los correos están en mi sitio que dejo al pie.
Aquí otra macro a considerar.
El proceso lo realiza en memoria.
Sub CopiarColumna()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, k As Long, m As Long
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
a = Range("A2:O" & Range("E" & Rows.Count).End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
For i = 1 To UBound(a, 1) Step 2
k = k + 1
m = 0
For j = 1 To UBound(a, 2)
m = m + 1
b(k, m) = a(i, j)
If j = 5 Then
m = m + 1
b(k, m) = a(i + 1, j)
End If
Next
Next
Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
Range("G1").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrBelow
MsgBox "Fin"
End Sub