Giorno a tutti
sta mattina mi sono imbattuto in questo errore:
Routine troppo grande
Potete consigliarmi come poterlo evitare?
Grazie mille
Moderatori: Anthony47, Flash30005
Public Sub Genera()
'dichiaro le variabili
Dim lRisposta As Long
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim lRiga1 As Long
Dim lRiga2 As Long
Dim lRigafine As Long
'metto un riferimento ai fogli
With ThisWorkbook
Set sh1 = .Worksheets("Forniture")
Set sh2 = .Worksheets("Caltiber")
Set sh3 = .Worksheets("Nicofer")
Set sh4 = .Worksheets("Garbin")
Set sh5 = .Worksheets("Siderurgica")
Set sh6 = .Worksheets("TipoSfere")
End With
'skrolling del monitor
Application.ScreenUpdating = False
For Each sh In Worksheets(Array("Caltiber", "Nicofer", "Siderurgica", "Garbin"))
sh.Range("A4:N100").Delete Shift:=xlUp
Next
For Each sh In Worksheets(Array("TipoSfere"))
sh.Range("A1:N100").Delete Shift:=xlUp
Next
With sh1
Range("A3:N3").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
"=Caltiber", Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Caltiber").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=NicoFer" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Nicofer").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
Range("A1:N2").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Garbin" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Garbin").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Siderurgica" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Siderurgica").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
'impagino il Foglio Distinte Sfere
With sh6
With .Range("A:N")
.Delete Shift:=xlUp
End With
With .Range("A:A")
.Columns.ColumnWidth = 9
End With
With .Range("B:B")
.Columns.ColumnWidth = 25
End With
With .Range("C:C")
.Columns.ColumnWidth = 12
End With
With .Range("D:D")
.Columns.ColumnWidth = 8
End With
With .Range("E:E")
.Columns.ColumnWidth = 12
End With
With .Range("F:L")
.Columns.ColumnWidth = 10
End With
With .Range("M:N")
.Columns.ColumnWidth = 12
End With
End With
' Sfere SLIM 100/225
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
With sh6
.Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3).MergeCells = True
With .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3)
.Value = "FORNITURE COBIAX ANNO 2011 - ORDINATE PER TIPOLOGIA SFERE"
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Bold = True
.Font.Size = 14
.HorizontalAlignment = xlCenter
.Rows.RowHeight = 20#
End With
End With
'filtro per Sfere Slim 100/225
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:= _
"=S-100/225", Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
sh6.Range("A" & lRiga2).CurrentRegion.ClearFormats
With sh6
.Range("A" & lRiga2 - 1).Value = "Codice"
.Range("B" & lRiga2 - 1).Value = "Nome Progetto"
.Range("C" & lRiga2 - 1).Value = "Solaio"
.Range("D" & lRiga2 - 1).Value = "Sistema"
.Range("E" & lRiga2 - 1).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 - 1).Value = "Nr. Sfere"
.Range("G" & lRiga2 - 1).Value = "Nr. Gabbie"
.Range("H" & lRiga2 - 1).Value = "Disegno Modulo"
.Range("I" & lRiga2 - 1).Value = "Connettori"
.Range("J" & lRiga2 - 1).Value = "Impresa"
.Range("K" & lRiga2 - 1).Value = "Produz."
.Range("L" & lRiga2 - 1).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 - 1).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 - 1).Value = "Prefabbric."
With .Range("A" & lRiga2 - 1 & ":N" & lRiga2 - 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 - 1 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 100/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 100/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-100/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 120/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 120/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-120/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 140/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 140/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-140/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 160/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 160/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-160/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 180/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 180/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-180/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
'ripristino l'aggiornamento del monitor
Application.ScreenUpdating = True
'Set a Nothing delle variabili oggetto
Set sh = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
Set sh3 = Nothing
Set sh4 = Nothing
Set sh5 = Nothing
Set sh6 = Nothing
End Sub
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
With sh6
call impaginazione
End With
With sh1
Range("A3:N3").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
"=Caltiber", Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Caltiber").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
...
Call Impaginazione(Foglio, Riga)
...
Sub Impaginazione(Sh, lRiga2)
Sheets(Sh).Range("A" & lRiga2 + 3).Value = "Codice"
Sheets(Sh).Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.....
End Sub
'impagino il Foglio Distinte Sfere
With sh6
.Range("A:N").Delete Shift:=xlUp
.Range("A:A").Columns.ColumnWidth = 9
.Range("B:B").Columns.ColumnWidth = 25
.Range("C:C, E:E,M:N").Columns.ColumnWidth = 12 ' Qui ho unito colonne con stessa larghezza
.Range("D:D").Columns.ColumnWidth = 8
.Range("F:L").Columns.ColumnWidth = 10
End With
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Public Sub Genera()
'dichiaro le variabili
Dim lRisposta As Long
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim lRiga1 As Long
Dim lRiga2 As Long
Dim lRigafine As Long
'metto un riferimento ai fogli
With ThisWorkbook
Set sh1 = .Worksheets("Forniture")
Set sh2 = .Worksheets("Caltiber")
Set sh3 = .Worksheets("Nicofer")
Set sh4 = .Worksheets("Garbin")
Set sh5 = .Worksheets("Siderurgica")
Set sh6 = .Worksheets("TipoSfere")
End With
'skrolling del monitor
Application.ScreenUpdating = False
For Each sh In Worksheets(Array("Caltiber", "Nicofer", "Siderurgica", "Garbin"))
sh.Range("A4:N100").Delete Shift:=xlUp
Next
For Each sh In Worksheets(Array("TipoSfere"))
sh.Range("A1:N100").Delete Shift:=xlUp
Next
With sh1
Range("A3:N3").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
"=Caltiber", Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Caltiber").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=NicoFer" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Nicofer").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
Range("A1:N2").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Garbin" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Garbin").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
With sh1
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Siderurgica" _
, Operator:=xlAnd
Rows("4:100").Select
Selection.Copy
Sheets("Siderurgica").Select
Range("A4").Select
ActiveSheet.Paste
Range("A1:N2").Select
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
Range("A1:N2").Select
Application.CutCopyMode = False
End With
'impagino il Foglio Distinte Sfere
With sh6
.Range("A:N").Delete Shift:=xlUp
.Range("A:A").Columns.ColumnWidth = 9
.Range("B:B").Columns.ColumnWidth = 25
.Range("C:C, E:E,M:N").Columns.ColumnWidth = 12
.Range("D:D").Columns.ColumnWidth = 8
.Range("F:L").Columns.ColumnWidth = 10
End With
' Sfere SLIM 100/225
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
With sh6
.Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3).MergeCells = True
With .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3)
.Value = "FORNITURE COBIAX ANNO 2011 - ORDINATE PER TIPOLOGIA SFERE"
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Bold = True
.Font.Size = 14
.HorizontalAlignment = xlCenter
.Rows.RowHeight = 20#
End With
End With
'filtro per Sfere Slim 100/225
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:= _
"=S-100/225", Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
sh6.Range("A" & lRiga2).CurrentRegion.ClearFormats
With sh6
.Range("A" & lRiga2 - 1).Value = "Codice"
.Range("B" & lRiga2 - 1).Value = "Nome Progetto"
.Range("C" & lRiga2 - 1).Value = "Solaio"
.Range("D" & lRiga2 - 1).Value = "Sistema"
.Range("E" & lRiga2 - 1).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 - 1).Value = "Nr. Sfere"
.Range("G" & lRiga2 - 1).Value = "Nr. Gabbie"
.Range("H" & lRiga2 - 1).Value = "Disegno Modulo"
.Range("I" & lRiga2 - 1).Value = "Connettori"
.Range("J" & lRiga2 - 1).Value = "Impresa"
.Range("K" & lRiga2 - 1).Value = "Produz."
.Range("L" & lRiga2 - 1).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 - 1).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 - 1).Value = "Prefabbric."
With .Range("A" & lRiga2 - 1 & ":N" & lRiga2 - 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 - 1 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere SLIM 100/315
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere PRO 100/315
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-100/315", _
Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
Ricky
Sei proprio sicuro che ti occorra tutto quello che hai scritto ... mi sembra che molte cose siano ripetute ...
Comunque NON TI OFFENDERE ma software presentato in modo peggiore non l'avevo mai visto
Ricky
Ti invio in pezzo che ho fatto per farti capire come va fatto per renderlo leggibile.
Ricky
ho visto che il codice per la sezione Sfere SLIM 100/315 è lo stesso di quello della sezione Sfere SLIM 120/315
l'unica differenza è il criterio con cui filtri la colonna "E" probabilmente andando avanti a leggere il codice si troveranno altre sezioni uguali
Ricky
Ecco le mie considerazioni:
i vari gruppi
da Sfere SLIM 100/315 a Sfere SLIM 220/315
da Sfere PRO 180 a Sfere PRO 450
da Sfere ECO 180 a Sfere ECO 360
Non li ho potuti guardare tutti e controllare le varie irghe di codice, però a me sembra che abbiano tutti le stesse istruzioni!!!
Confermi ???
Hai ripetuto più volte i gruppi ed hai modificato le condizioni di filtro ???
Se le due risposte sono “SI” allora si può ottimizzare molto.
Anthony
Essendo la macro molto "lineare" credo che sia facile spezzarla in due e metterle su due moduli diversi. Probabilmente bastera' ripetere le dichiarazioni e i Set iniziali e poche altre cose.
Sub Genera_BIS(sh1, sh6)
' Sfere ECO 180
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere ECO 180
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-180" _
, Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere ECO 225
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere ECO 225
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-225" _
, Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere ECO 270
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere ECO 270
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-270" _
, Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
' Sfere ECO 360
With sh1
lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
If lRiga2 < 5 Then lRiga2 = 4
'filtro per Sfere ECO 360
Sheets("Forniture").Select
ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-360" _
, Operator:=xlAnd
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
.Range("A" & lRiga2 + 3).Value = "Codice"
.Range("B" & lRiga2 + 3).Value = "Nome Progetto"
.Range("C" & lRiga2 + 3).Value = "Solaio"
.Range("D" & lRiga2 + 3).Value = "Sistema"
.Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
.Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
.Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
.Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
.Range("I" & lRiga2 + 3).Value = "Connettori"
.Range("J" & lRiga2 + 3).Value = "Impresa"
.Range("K" & lRiga2 + 3).Value = "Produz."
.Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
.Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
.Range("N" & lRiga2 + 3).Value = "Prefabbric."
With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
'copio/incollo
.Range("A4:N100" & lRiga1).Copy _
Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
With .Range("F" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0"" sf"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
With .Range("G" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" g"""
.Font.Color = -16776961
End With
lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
With .Range("M" & lRigafine + 1)
.Font.Bold = True
.NumberFormat = "0.00"" mq"""
.Font.Color = -16776961
End With
End With
With sh6
Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With
End If
End With
'tolgo il filtro nel foglio FILE_txt
With sh1
.Range("$A$3:$N$3").AutoFilter Field:=5
End With
End Sub
Call Genera_BIS(sh1, sh6)
Torna a Applicazioni Office Windows
Un ciclo per non far diventare la routine troppo lunga Autore: zanatta77 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 56 ospiti