Te anexo la macro del informa anual
Sub InformeAnual()
'Por.Dante Amor
u = Hoja9.Range("A" & Rows.Count).End(xlUp).Row
If u < 3 Then u = 3
Hoja9.Range("A2:P" & u).ClearContents
'
'u = Hoja4.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row
Set b = Hoja9.Range("A:A").Find(Hoja4.Cells(i, "A"), LookAt:=xlWhole)
mes = Month(Hoja4.Cells(i, "B")) + 2
If Not b Is Nothing Then
Hoja9.Cells(b.Row, mes) = Hoja9.Cells(b.Row, mes) + Hoja4.Cells(i, "D")
Else
Set c = Hoja1.Range("A:A").Find(Hoja4.Cells(i, "A"), LookAt:=xlWhole)
If Not c Is Nothing Then
desc = Hoja1.Cells(c.Row, "B")
End If
u = Hoja9.Range("A" & Rows.Count).End(xlUp).Row + 1
Hoja9.Cells(u, "A") = Hoja4.Cells(i, "A")
Hoja9.Cells(u, "B") = desc
Hoja9.Cells(u, mes) = Hoja4.Cells(i, "D")
End If
Next
'
'totales
For i = 2 To Hoja9.Range("A" & Rows.Count).End(xlUp).Row
Hoja9.Cells(i, "O") = Application.Sum(Hoja9.Range("C" & i & ":N" & i))
Hoja9.Cells(i, "P") = Hoja9.Cells(i, "O") / 12
Set b = Hoja6.Range("A:A").Find(Hoja9.Cells(i, "A"))
If Not b Is Nothing Then
Hoja9.Cells(i, "Q") = Hoja6.Cells(b.Row, "B")
End If
Next
Hoja9.Select
MsgBox "Informe Anual Terminado", vbInformation
End Sub