Link per il formato XLS (Office '97-2003):
https://mega.nz/file/WNJV0aKJ#CJFI3qZ0wGLowgRQuzuNAynLl5MlL6y_0HjESlUpDOs
Link per il formato XLSM (Office più recente):
https://mega.nz/file/aBJlSRRT#BvMaqj4CU1Fna5gsKg0LgkKy118nQVmsGm6zdYNZs7c
Ora è corretto. I tentativi di modificare la macro "CopiaCelle", per far si che cancelli i numeri segnalati ed usciti, per ora non ha dato esito.
Le macro fornite dall'IA danno errore, anche se le macro sono attivate appare l'errore: Impossibile trovare la macro. Forse le macro sono disabilitate. In realtà le altre macro funzionano. Misteri per chi come me non capisce un'H e neanche una B.
Questa è la macro incriminata:
------------------------------------------------------------------------------------------------
Sub CopiaEDistribuisciDati()
Dim wsBari As Worksheet
Dim wsPercentuali As Worksheet
Dim prevNumbers As Collection
Dim rng As Range
Dim cell As Range
Dim i As Integer
Dim prevNumber As Variant
Dim colToClear As String
' Imposta i fogli
Set wsBari = ThisWorkbook.Sheets("Bari")
Set wsPercentuali = ThisWorkbook.Sheets("Percentuali")
Set prevNumbers = New Collection
' Definire gli intervalli da leggere
Set rng = Union(wsBari.Range("C2:G15"), wsBari.Range("B13:G21"), wsBari.Range("B24:G32"), wsBari.Range("B35:G43"), wsBari.Range("B46:G54"), wsBari.Range("C57:G65"))
' Loop attraverso ogni cella nell'intervallo
For Each cell In rng
If IsNumeric(cell.Value) Then
i = cell.Value
If i >= 1 And i <= 90 Then
' Copia i dati in base alla fascia di numeri
If i >= 1 And i <= 15 Then
wsPercentuali.Range("D" & (i + 2) & ":R" & (i + 2)).Copy Destination:=wsPercentuali.Range("AL" & (i + 2) & ":AZ" & (i + 2))
ElseIf i >= 16 And i <= 30 Then
wsPercentuali.Range("D" & (i + 3) & ":R" & (i + 3)).Copy Destination:=wsPercentuali.Range("AL" & (i + 3) & ":AZ" & (i + 3))
ElseIf i >= 31 And i <= 45 Then
wsPercentuali.Range("D" & (i + 4) & ":R" & (i + 4)).Copy Destination:=wsPercentuali.Range("AL" & (i + 4) & ":AZ" & (i + 4))
ElseIf i >= 46 And i <= 60 Then
wsPercentuali.Range("D" & (i + 5) & ":R" & (i + 5)).Copy Destination:=wsPercentuali.Range("AL" & (i + 5) & ":AZ" & (i + 5))
ElseIf i >= 61 And i <= 75 Then
wsPercentuali.Range("D" & (i + 6) & ":R" & (i + 6)).Copy Destination:=wsPercentuali.Range("AL" & (i + 6) & ":AZ" & (i + 6))
ElseIf i >= 76 And i <= 90 Then
wsPercentuali.Range("D" & (i + 7) & ":R" & (i + 7)).Copy Destination:=wsPercentuali.Range("AL" & (i + 7) & ":AZ" & (i + 7))
End If
' Controlla i numeri precedenti e cancella le celle corrispondenti
colToClear = "" ' Resetta la variabile colToClear
For Each prevNumber In prevNumbers
If prevNumber = i - 1 Then
colToClear = "AU"
ElseIf prevNumber = i - 2 Then
colToClear = "AM"
End If
If colToClear <> "" Then
wsPercentuali.Range(colToClear & (i + 2)).ClearContents
End If
Next prevNumber
' Aggiungi il numero corrente alla lista dei numeri precedenti
prevNumbers.Add i
End If
End If
Next cell
End Sub
--------------------------------------------------------------------------------------------------------------------------------------
Che, tra l'altro, sono convinto sia non funzionante correttamente.
Buon Non Onomastico a tutti
Baciccia