Ciao Anthony,
c’è ancora qualche problema…
qusta la riga in errore :
- Codice: Seleziona tutto
ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange.Offset(0, -1).ClearContents
Errore di run-time “91”: variabile oggetto o variabile del blocco With non impostata
Questa è la macro intera:
- Codice: Seleziona tutto
Application.ScreenUpdating = False
Sheets("Foglio79").Select
ActiveSheet.Unprotect
ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange.Offset(0, -1).ClearContents
With ActiveSheet.ListObjects("Tabella162425")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With
UR = Range("D" & Rows.Count).End(xlUp).Row 'cancello le righe eventualmente presenti
If UR < 6 Then UR = 6 'in tabella162425 per inserire i nuovi
Rows("6:" & UR).Delete Shift:=xlUp 'dati sempre aggiornati
With ActiveSheet.ListObjects("Tabella162425")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With
Sheets("Foglio80").Select
ActiveSheet.Unprotect
ActiveSheet.ListObjects("Tabella41627").Range.AutoFilter Field:=1, Criteria1:= _
"<>"
On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella41627[Classe]:Tabella41627[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
With Range("Tabella41627").SpecialCells(xlCellTypeVisible)
NewLin = .Count / .Columns.Count 'RigheVis=N° righe visibili
End With
Selection.Copy 'copio il range che incollerò in Griglia
Sheets("Foglio79").ListObjects("Tabella162425").Resize _
Range("Tabella162425").Offset(-1, 0).Resize(Range("Tabella162425").Rows.Count + NewLin + 1)
Sheets("Foglio79").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio80").Select
ActiveSheet.ListObjects("Tabella41627").Range.AutoFilter Field:=1
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Primo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sheets("Foglio79").Select
With ActiveSheet.ListObjects("Tabella162425")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With
Sheets("Foglio49").Select
ActiveSheet.Unprotect
ActiveSheet.ListObjects("Tabella1151832").Range.AutoFilter Field:=136, Criteria1:= _
"Esterno"
On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella1151832[Colore Classe2]:Tabella1151832[Delegati3+NumeroTel]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
With Range("Tabella1151832").SpecialCells(xlCellTypeVisible)
NewLin = .Count / .Columns.Count 'RigheVis=N° righe visibili
End With
Selection.Copy
Sheets("Foglio79").ListObjects("Tabella162425").Resize _
Range("Tabella162425").Offset(-1, 0).Resize(Range("Tabella162425").Rows.Count + NewLin + 1)
Sheets("Foglio79").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio49").Select
ActiveSheet.ListObjects("Tabella1151832").Range.AutoFilter Field:=136
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Secondo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sheets("Foglio79").Select
ActiveSheet.Unprotect
With ActiveSheet.ListObjects("Tabella162425")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With
Application.AddCustomList ListArray:=Array("Nido", "Esterno")
ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort.SortFields. _
Add Key:=Range("Tabella162425[Classe]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="Nido,Esterno", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error Resume Next
Sheets("Foglio79").Select
UR = Range("D" & Rows.Count).End(xlUp).Row
If UR < 6 Then UR = 6
Range("C6:D" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
On Error GoTo 0
Sheets("Foglio79").Select
Range("Tabella162425").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
Selection.RowHeight = 60
End With
Range("Tabella162425[Classe]").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C7:V116").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.249977111117893
.PatternTintAndShade = 0
End With
Range("Tabella162425").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15382741
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1").Select
For Each Cell In ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange
I = I + 1: Cell.Offset(0, -1) = I
Next Cell
Sheets("Foglio75").Select
Application.ScreenUpdating = True
End Sub
Pensavo che magari potrebbe essere meno complicato ottenere il risultato che vorrei, se trasformassi la semplice ColonnaB in una colonna appartenente sempre alla Tabella162425.
Devo fare così?
Grazie