Sub MiCalendario() Dim i As Integer Dim fecha As Date Dim aumento As Integer Dim s As Integer Dim contador Range("B4").Select Application.ScreenUpdating = False s = 1 'tomo la fecha inicial de cualquier año fecha1 = CDate(InputBox("ingrese la fecha, bajo el formato dd/mm/aaaa, Ejemplo: 01/12/2012 ")) 'con un bucle recorro todos los meses del año inicio en 0 para que tome el mes de la fecha que le_ 'anexamos al principio contador = 0 For aumento = 0 To 11 contador = contador + 1 fecha2 = DateSerial(Year(fecha1), Month(fecha1) + aumento, Day(fecha1)) ' voy aumentando un mes a la fecha inicial fecha = DateSerial(Year(fecha2), Month(fecha2), Day(fecha2)) 'para quenos quede la fecha a utilizar en la macro año = Year(fecha) ' tomo el año de la fecha mes = Month(fecha) ' tomo el mes de la fecha ' el dia inicial tomando en cuanta para mi gusto que lunes es el primer dia de la semana inicio = Weekday(DateSerial(año, mes, 1), vbSunday) fin = Day(DateSerial(año, mes + 1, 1) - 1) j = 1 ' primer dia del mes p = inicio ' de lun a vier que colocamos el valor de los dia dependiendo del mes For x = 1 To fin ActiveCell.Offset(j - 1, p - 1) = x ActiveCell.Offset(-2, 0).Value = DateSerial(año, mes, 1) ActiveCell.Offset(-2, 0).NumberFormat = "mmmm-yyyy" ActiveCell.Offset(-2, 0).Interior.ColorIndex = Int(Rnd * 55) + 1 ' ActiveCell.Offset(-1, 0).Value = "Domingo" ActiveCell.Offset(-1, 1).Value = "Lunes" ActiveCell.Offset(-1, 2).Value = "Martes" ActiveCell.Offset(-1, 3).Value = "Miércoles" ActiveCell.Offset(-1, 4).Value = "Jueves" ActiveCell.Offset(-1, 5).Value = "Viernes" ActiveCell.Offset(-1, 6).Value = "Sábado" If p = 7 Then p = 0 j = j + 1 End If p = p + 1 Next ActiveCell.Offset(0, 9).Select If contador = 3 Or contador = 6 Or contador = 9 Or contador = 12 Then ActiveCell.Offset(9, -27).Select End If Next Application.ScreenUpdating = True End Sub