Corregir para que no borre datos
DANTE CORREGÍ LO QUE ME DIJISTE
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
u = 4
Pero el problema esta en que si las columnas están filltradas las tiene que desfiltrar y cuando cambie el codio x u=4 me borra lo que ya había archivado necesito que no me lo borre que siga acumulando me explico si podes mándame el archivo corregido gracias
1 Respuesta
Así quedaría la macro
Sub fechas()
'Por.Dante Amor
Dim fec1 As Date, fec2 As Date
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
fec1 = h1.Range("B2")
fec2 = h1.Range("B3")
Select Case h1.Range("B4")
Case 1: meses = 12
Case 2: meses = 6
Case 3: meses = 4
Case 4: meses = 3
Case 6: meses = 2
Case 12: meses = 1
End Select
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
If u < 4 Then u = 4
Do While fec1 <= fec2
h2.Cells(u, "A") = h1.Range("B6")
h2.Cells(u, "B") = fec1
h2.Cells(u, "C") = h1.Range("B1")
h2.Cells(u, "D") = h1.Range("B5")
fec1 = DateSerial(Year(fec1), Month(fec1) + meses, Day(fec1))
u = u + 1
Loop
h2.Select
MsgBox "Fechas Calculadas"
End Sub
Perdona, utiliza esta macro.
Primero limpia tu hoja2 para eliminar posibles blancos que tengas en las celdas.
Sub fechas()
'Por.Dante Amor
Dim fec1 As Date, fec2 As Date
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
fec1 = h1.Range("B2")
fec2 = h1.Range("B3")
Select Case h1.Range("B4")
Case 1: meses = 12
Case 2: meses = 6
Case 3: meses = 4
Case 4: meses = 3
Case 6: meses = 2
Case 12: meses = 1
End Select
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
If u < 4 Then u = 4
Do While fec1 <= fec2
h2.Cells(u, "A") = h1.Range("B6")
h2.Cells(u, "B") = fec1
h2.Cells(u, "C") = h1.Range("B1")
h2.Cells(u, "D") = h1.Range("B5")
fec1 = DateSerial(Year(fec1), Month(fec1) + meses, Day(fec1))
u = u + 1
Loop
h2.Select
MsgBox "Fechas Calculadas"
End Sub
Perdona, ahora sí esta es la buena. Faltó el + 1
Sub fechas()
'Por.Dante Amor
Dim fec1 As Date, fec2 As Date
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
fec1 = h1.Range("B2")
fec2 = h1.Range("B3")
Select Case h1.Range("B4")
Case 1: meses = 12
Case 2: meses = 6
Case 3: meses = 4
Case 4: meses = 3
Case 6: meses = 2
Case 12: meses = 1
End Select
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
If u < 4 Then u = 4
Do While fec1 <= fec2
h2.Cells(u, "A") = h1.Range("B6")
h2.Cells(u, "B") = fec1
h2.Cells(u, "C") = h1.Range("B1")
h2.Cells(u, "D") = h1.Range("B5")
fec1 = DateSerial(Year(fec1), Month(fec1) + meses, Day(fec1))
u = u + 1
Loop
h2.Select
MsgBox "Fechas Calculadas"
End Sub
Dante disculpa pero copie el código como me decís y me empieza archivar por la fila 14
Miralo y tené en cuenta cuando la hoja dos este filtrada por favor te mando el archivo por mail gracias
Borra toda la hoja o empieza en una nueva
¡Gracias! Dante ahora anda perfecto te pregunto también corregiste lo de los filtros no ahora aunque este filtrado busca la ultima celda es así verdad
No he tenido tiempo de ver lo de los filtros. Lo único que hace, aunque esté filtrado es buscar la última fila, por eso si tienes espacios en blanco en las celdas, son consideradas como celdas ocupadas y por eso a veces te enviaba la información a la fila 14.
ok pero si esta ordenado y no hay espacios en blanco en toda la columna y esta filtrado siempre va a pegar los dato en la ultima celda libre no
Correcto
