Te anexo una macro para realizar lo que solicitas.
Instrucciones en tu hoja de excel
En la hoja de Excel tienes que poner en A2 el mes inicial
En B2 el mes final
De A5 hacia abajo los meses
De B5 hacia abajo las semanas por mes
Te tiene que quedar algo similar a la imagen anexa
http://www.subeimagenes.com/img/calculasem-417394.html
http://www.subeimagenes.com/img/calculasem-417394.html
Instrucciones para crear la macro
1. Abre tu hoja de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5
'*****Macro*****
Public inicial, unav, dias As Integer
Sub semanas()
'Por.Dam
'Busca cuantas semanas hay en 2 meses
'Call valida1
mesini = Range("A2")
mesfin = Range("B2")
sumasem = 0
semini = 1
semfin = 1
inicial = 4
unav = 1
dias = 1
'Range("H:J").Clear
For i = 5 To 17
Cells(i, 1).Select
'suma sem inicial
If semini = 1 Then
If Cells(i, 1) = mesini Then
sumasem = sumasem + Cells(i, 2)
semini = 2
If mesini = mesfin Then
'ini fin son iguales
Exit For
End If
End If
Else
If Cells(i, 1) = mesfin Then
'suma mes final
sumasem = sumasem + Cells(i, 2)
semfin = 2
Exit For
Else
If semfin = 1 Then
'acumula intermedios
sumasem = sumasem + Cells(i, 2)
End If
End If
End If
' i = i + 1
Next
Range("C2").Value = sumasem
numcuadros = Round(sumasem / 7)
For j = 1 To numcuadros
Call enmarca
dias = dias + 7
Next
End Sub
Sub enmarca()
'
'Range("H10:k30").Select
If unav = 1 Then
inicial = inicial + 3
unav = 2
Else
inicial = inicial + 4
End If
Range(Cells(10, inicial), Cells(100, inicial + 3)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Range("H10").Select
Cells(10, inicial).Select
ActiveCell.Value = "Semana " & dias & " al " & dias + 6
'Range("H10:K10").Select
Range(Cells(10, inicial), Cells(10, inicial + 3)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub
'*****Macro*****
Notas:
Si requieres que los datos de meses y semanas por mes estén en otra hoja o en otra posición, habrá que realizar cambios en la macro.
Saludo. DaM
No olvides cerrar la pregunta.