Ho inserito la tua modifica ma il problema è rimasto.
Sono comunque riuscito a risolvere il problema con una mezza furbata..
Avevo notato che la macro riusciva ad eliminare le righe vuote prima della riattivazione della protezione, soltanto se si trovavano vicine.
..A qesto punto mi è venuta l'idea di filtrare i dati, così facendo le righe rimaste vuote si raggruppano ai piedi della tabella e all'atto della riattivazione della protezione vengono eliminate correttamente.
Questa la macro:
- Codice: Seleziona tutto
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("Tabella1[#Headers]").Select
Selection.Copy
Range("Tabella1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A8:D8").Select
Selection.ListObject.ListRows(1).Delete
Range("A5:D5").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("Tabella1[Mese]").Select
ActiveWorkbook.Worksheets("Foglio4").ListObjects("Tabella1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Foglio4").ListObjects("Tabella1").Sort.SortFields. _
Add Key:=Range("Tabella1[Mese]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"gennaio,febbraio,marzo,aprile,maggio,giugno,luglio,agosto,settembre,ottobre,novembre,dicembre" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Foglio4").ListObjects("Tabella1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error Resume Next<<<<<<<<<<<<errore di run.time 1004 (errore nel metodo delete per la classe range
Sheets("Foglio4").Select
UR = Range("D" & Rows.Count).End(xlUp).Row - 1
If UR < 7 Then UR = 7
Range("A7:D" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A5").Select
On Error GoTo 0
Range("Tabella1").Select
Selection.Locked = True
Range("A5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Grazie per le svariate dritte
Marte1503
