Originariamente inviato da NonCeLaFaccio+
Ciao,
se ho capito bene questo dovrebbe fare quello che chiedi:

codice:
Private Sub CommandButton1_Click()

   With Range("H:H")
      .Value = ""
   End With
   
   For Each casella In Range("a1", "g10")

       If casella.Interior.ColorIndex = xlColorIndexNone Then
          casella.Value = ""
       Else
          If Cells(casella.Row, 8).Value = "" Then
             Cells(casella.Row, 8).Value = casella.Value
          Else
             Cells(casella.Row, 8).Value = Cells(casella.Row, 8).Value & "," & casella.Value
          End If
       End If

   Next

End Sub

Il with iniziale ripulisce la colonna H da precedenti contenuti e poi il ciclo esplora il range dei dati (impostalo con il tuo range) e, casella per casella si chiede se il colore interno è impostato o meno.

Se non è impostato cancella il contenuto della cella.

Se invece è impostato accoda il contenuto della cella a quanto già presente nella cella H (che è la numero 8).

Vedi un po' se va bene
Ciao
Grazie mille! Non vedo l'ora di provarla! Ma quando ci provo assegnandola ad una forma scelta per il pulsante... quando ci clicco mi dice

Impossibile eseguire la macro "miofile-nomemacro" . E' possibile che tale macro non sia disponibile nella cartella di lavoro o che tutte le macro siano disattivate...

Ora in seguito a questo messaggio ho provato ad attivare tutte le macro da opzioni di excel e a salvare in fase di assegnamento macro la macro stessa in ognuna delle tre opzioni di destinazione macro possibili.. a chiudere e riavviare excel ogni volta... ma sempre al momento del click sul pulsante mi da il solito errore...


Adesso sono riuscito a farla attivare (togliendo il Private)
Ma anzichè cancellarmi solo i valori "non rossi" del range preimpostato A1:BC2
mi cancella tutto

codice:
Sub provanuovamacro()
   With Range("A1:BC2")
      .Value = ""
   End With
   
   For Each casella In Range("A1", "BC2")

       If casella.Interior.ColorIndex = xlColorIndexNone Then
          casella.Value = ""
       Else
          If Cells(casella.Row, 8).Value = "" Then
             Cells(casella.Row, 8).Value = casella.Value
          Else
             Cells(casella.Row, 8).Value = Cells(casella.Row, 8).Value & "," & casella.Value
          End If
       End If

   Next
End Sub