M
MS
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").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" & nr & ")"
End With
End With
End Sub
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").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" & nr & ")"
End With
End With
End Sub