Mejorara una macro_inserta 5 filas hacia arriba si es que encuentra datos en una columna
Como puedo mejorar esta macro:
Tengo una tabla con datos del siguiente modo.
A B C
FECHA VENTA1 VENTA2
12/02/2014 34 45
45 50
15/02/2014 50 60
16/02/2014 80 90
...... ..... .....
Lo que busco es insertar 5 filas arriba de cada fila con valores de fecha en la columna a:a, la macro que muestro solo inserta una fila, en al rpimera fila con fecha sin embargo no puede hacer ello con todas las filas que cuenta la tabla que llegan hasta 3000.
AGRADECERPE SI SI LE DAN UN VISTAZO Y ME AYUDAN
Sub isertafila()
'macro que debe insertar 5 filas hacia arriba cada vez que encuentre una celda con fecha en la columna ("A:A")
Application.ScreenUpdating = False
For Each celda In Range("A2:A3")'cuando esta activa esta línea funcuona bie'n sim embargo cuando yo quiero ampliar mi rango hasta "A3000" ya no puede 'ejecutar se cuelga
'For Each celda In Range("A2:A3000")'===============esta linea como modifico
If IsDate(celda) Then Rows(celda.Row).Insert
Next
Application.ScreenUpdating = True
Set celda = Nothing
End Sub
Dim Counter
Dim i As Integer
End Sub
3 Respuestas
El problema es que cuando aumentas 5 filas cada vez que encuentre una fecha en la columna A, el rango cambia, serían 5 filas más. Te dejo una macro que hace lo que tu deseas. En vez de utilizar for each, utilizo Do While porque no podemos cambiar el rango (utilizando for each) una vez que se ha evaluado por primera vez.
Sub Insertafilas()
nf = 5 ' Número de filas a insertar
'uf= Última fila con datos de la columna A
uf = Range("A" & Rows.Count).End(xlUp).Row
'Fila donde comienzan los datos
fil = 2
'macro que debe insertar 5 filas hacia arriba
'cada vez que encuentre una celda con fecha en la columna ("A:A")
Application.ScreenUpdating = False
'Mientras la fila sea inferior a la última fila seguirá
'ejecutándose la macro.
'uf y fil irán cambiando su valor cada vez que se insertan filas en blanco
Do While fil <= uf
celda = Range("A" & fil).Value
If IsDate(celda) Then
For t = 1 To nf ' Inserta nf filas
Rows(fil).Insert
Next t
'Incrementamos fil y uf cuando insertamos 5 filas
fil = fil + 6
uf = uf + 5
Else
'Si son filas en blanco hay que incrementar en 1 el contador de filas
fil = fil + 1
End If
Loop
Application.ScreenUpdating = True
End SubSi te ha valido, no olvides valorar la respuesta.
¡Gracias!
La respuesta es excelente.
sin embargo cuando he tratado de jecutar la macro me inserta filas pero no como busco, inserta filas solamente para la primera celda empezando desde la ultima parte .
pero de todos modos Grcaias por tu atención.
ya esta solucionado.
saludos
e igual para usted e Feliz Navidad¡¡¡¡¡¡¡
Le hice el ajuste a la macro para que inserte filas, recuerda que para insertar o borrar debes empezar de la última fila a la primera.
Sub Insertar5Filas()
'Por.Dante Amor
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If IsDate(Cells(i, "A")) Then Range("A" & i & ":A" & i + 4).EntireRow.Insert xlDown
Next
End Sub
¡Gracias!
Dante.
Ya está, corrí la macro como me indicaste y efectivamnete hace lo que buscaba.
es usted extraoridnario
saludos
Celim
Prueba con esto.
Espero te ayude.
Sub isertafila()
Dim i, x, z As Integer
Application.ScreenUpdating = False
z = 3000 ' Celda donde terminan los datos
For i = 2 To z
If IsDate(Cells(i, 1)) Then
For x = 1 To 5 ' este for inserta las 5 filas
Rows(Cells(i, 1).Row).Insert
Next
z = z + 5 'Al insertar filas el rango aumenta por eso debo asegurar que recorre todo el rango
i = i + 5
End If
Next
Application.ScreenUpdating = True
End Sub
¡Gracias! ,Eduardo Caballero.
esta recontra super bien la Macro.
Felices fiestas , que la vida siempre sea bella para usted.
Saludos,desde Puerto Maldonado, Perú.
y que Venezuela avance hermano.