Hi all,
I have the following Macro,
In the numbers 1-2-3
there is a mistake
Thanks in advance.

Marcello

   Sub Archivia()
   Dim SH As Worksheet
   Dim Name As String
   Dim i As Long
   Dim DataDoc As Date
1-Dim ConPag1 As Currency
  Dim ConPag As Currency
  Dim rng As Range
  Dim c As Range
  Dim im As Double
  Dim mi As Long
  Dim nr As Long
  Dim ia As Double
  Dim ai As Long
  Dim n As Long, r As Long

    With Sheets("sheet3")

       .Columns("A:D").ColumnWidth = 10
       .Columns("E:F").ColumnWidth = 15
       .Columns("G").ColumnWidth = 16.86
       .Columns("H:O").ColumnWidth = 8.43

       n = Worksheets.Count

       .Range("A1").Value = Worksheets(n).Range("G13").Value

       i = 2

 .Range("A3:G1000").ClearContents
 For Each SH In Worksheets
   If SH.Name <> "Sheet3" Then

     DataDoc = 0
     For r = 18 To 25
       If SH.Cells(r, 4).NumberFormat = "m/d/yyyy" Then
         DataDoc = SH.Cells(r, 4)
         Exit For
       End If
     Next

     2-ConPag1 = 0
        For r = 45 To 53
       If SH.Cells(r, 5).NumberFormat = "00;Standard" Then
       ConPag = SH.Cells(r, 5)
       Exit For
       End If

       Next
     ConPag = 0
     For r = 80 To 100
       If SH.Cells(r, 4).NumberFormat = "#,##0.00" Then
         ConPag = SH.Cells(r, 4)
         Exit For
       End If
       Next
     i = i + 1
     .Cells(i, 1) = SH.Name
     .Cells(i, 2) = DataDoc
3- .Cells(i, 3) = ConPag1
     .Cells(i, 4) = ConPag
       End If
       Next

   With Worksheets("sheet3")

       nr = .Range("B65536").End(xlUp).Row
       Set rng = .Range("B3:B" & nr)

           mi = Month(.Range("B3").Value)
           ai = Year(.Range("B3").Value)

       For Each c In rng

           If Month(c.Value) = mi And Year(c.Value) = ai Then
               im = im + c.Offset(0, 1).Value
           Else
               c.Offset(-1, 2).Value = im
               im = c.Offset(0, 1).Value
               mi = Month(c.Value)
           End If

           If Year(c.Value) = ai Then
               ia = ia + c.Offset(0, 1).Value
           Else
               c.Offset(-1, 3).Value = ia
               c.Offset(-1, 4).Value = "Totale anno: " & ai
               ia = c.Offset(0, 1).Value
               ai = Year(c.Value)
           End If

       Next

       Set rng = Nothing

       .Range("D" & nr).Value = im
       .Range("E" & nr).Value = ia
       .Range("F" & nr).Value = "Totale anno: " & ai
       .Range("B" & nr + 1).Value = "Totale"
       .Range("D" & nr + 1).Formula = "=SUM(D2:D" & nr & ")"

   End With
End With

End Sub