Agregar código en esta macro
Dante ahí te mande el archivo con las explicaciones para agregar algo gracias
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
Do While fec1 <= fec2
h2.Cells(u, "A") = fec1
h2.Cells(u, "B") = h1.Range("B1")
h2.Cells(u, "C") = h1.Range("B5")
fec1 = DateSerial(Year(fec1), Month(fec1) + meses, Day(fec1))
u = u + 1
Loop
h2.Select
MsgBox "Fechas Calculadas"
End Sub
1 respuesta
Respuesta de Dante Amor
1
Esta es la macro con la actualización, cámbialo en tu archivo.
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
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
