Comprobar valor en un rango. Cortar y borrar fila según valor
Para dar formato a una tabla con más de 16000 filas. La cuestión es que está mal diseñada.
Tengo un rango, la columna E, con 2 tipos de valores, uno de texto, que no me interesa moverlo, ni su fila de datos.
Sin embargo, hay un valor con una fecha, que me gustaría copiarlo, mejor cortarlo y llevarlo a la columna A, que esta vacía. Este valor (la fecha) se tendría que copiar en el rango A, hasta encontrar otra fecha distinta y así sucesivamente.
A su vez, la fila donde esta la fecha eliminarla.
Os añado mi código, pero no lo consigo acabar
Sub MoverFecha()
ufila = Range("E" & Rows.Count).End(xlUp).Row
col = Range("E2").Column
k = 5
For i = 2 To ufila
'No consigo poner una condicion de fecha
'Me copia,ya sea texto o fecha
If Cells(i, col) > DateValue("01/01/2012") Then
Sheets("Hoja5").Range("A" & i + 1) = Sheets("Hoja5").Range("E" & i)
k = k + 1
End If
Next
End Sub
2 Respuestas
Si, disculpa mi torpeza.
Esta seria la hoja, que ya he modificado algunas cosas con parte de código, que tengo a medias.
Ahora quería :
La fila de descripción de producto:
- Eliminar espacios en blanco, fila completa
- eliminar y copiar la fila donde esta la fecha y pegarla en la columna A(vacía)
- además copiarse en todas las siguientes filas(rangoA) hasta encontrar la siguiente fecha.
- En las filas de texto, separa el contenido en 2 o 3 celdas, me es indiferente.
Las filas de RfColor y Base:
- Darles formato personalizado con 0000000000000(13)
- Añadir un 0 al principio del numero, en muchas líneas falta. A mi me interesa para crear la base de datos. He probado cosas, pero aunque el formato me añada el primer cero, en realidad no tiene el valor con dicho cero.
Muchísimas gracias por tu atención.
Sub FormatoHistorico()
'
'Cogiendo archivo corob 2016, lo paso a hoja como HistoricoTotal, sin macro
'Guardar como Xlsm
'ESTA MACRO ES SOLO DE UNA EJECUCION, POR SER EL PRIMER HISTORICO
Dim mes As Worksheet, _
LValue As String, _
i As Date
i = Month(Now)
LValue = MonthName(i, True)
'Apagar parpadeo pantalla
Application.ScreenUpdating = False
'Establecer directorio por defecto
ChDir "C:\Users\PereTaller\Documents\Materis\siti\con vba"
'Abrir archivo Corob para recuperar el historico
'ojo con el directorio
Workbooks.Open Filename:= _
"C:\Users\PereTaller\Documents\Materis\siti\con vba\Corob 2016.xlsm", _
UpdateLinks:=0
'Selecciona la hoja que queremos copiar y formatear
Sheets("Febrero 2016").Select
'Copiamos la hoja que QUEREMOS
Sheets("Febrero 2016").Copy After:=Workbooks("Corob Historico.xlsm").Sheets(1 _
)
'Cerrar libro
Workbooks("Corob 2016.xlsm").Close (SaveChanges = False)
'situamos en a1 en la hoja nueva para formatear
'Le cambiamos nombre
Windows("Corob Historico.xlsm").Activate
With Sheets("Febrero 2016")
.Name = LValue
End With
'Seleccionar Rango a copiar en otra hoja
Range("a1").Select
' Borra la primera fila
If Cells(1, 3).Value = "PRODUCTOS FABRICADOS" Then
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
'poner cursor primera columna
ActiveCell.Offset(0, 0).Range("A1").Select
'Aplico formato fecha al rango A
Range("A1").NumberFormat = "dd/mm/yyyy;@"
''Insertar una Fila y posicionarse en la primer columna de la Fila Anterior
'Selection.EntireRow.Insert
'ActiveCell.EntireRow.Cells(1, 1).Offset(-1, 0).Activate
'Insertar columna
If Range("A1") > 0 Then
Range("A1").Select
Range("A1").EntireColumn.Insert
End If
'Cells(1, 1).Select
'Columns("A:A").Select
'Aplico formato fecha al rango A
'Selection.NumberFormat = "dd/mm/yyyy;@"
Dim rngTotal As Range, _
Hoja2 As Worksheet
Set rngTotal = Range("A1:H100")
Set Hoja2 = Sheets.Add.Name = i +
Cells("A1").Select
rngTotal.Copy (Hoja2)
'quitar espacios entre filas
'For Fila = 1 To 60
'If Cells(Fila, 5).Value = "" Then
'Rows(Fila).Delete
'End If
'Next Fila
'borrar portapapeles
Application.CutCopyMode = False
End Sub
