Selezione Multipla di celle

Question

Salve, sto cercando di creare una macro che, dato un certo intervallo, selezioni e copi tutte le celle che soddisfano una certa condizione. Tento di spegarmi meglio. Sul foglio1 ho un intervallo di celle A1:Z20 , vorrei copiare tutte le celle che hanno valore p.e. 100 e fare la copia sul Foglio2. Ovviamente le celle che contengono 100 possono essere sparse, non adiacenti e variare di volta in volta. La macro dovrebbe fare una selezione delle celle una ad una tipo, per intenderci, quella che farei manualmente tenendo premuto il CTRL ed effettuare la copia rispettando le "posizioni" delle singole celle. Ho fatto qualche tentativo, ma penso che questa cosa sia al di là delle mia capacità. Grazie per l'aiuto. Ciao

Fabrizio

Answer 1

Ciao Fabrizio,

prova a vedere se questa ti è utile

---

Sub CopiaSparsa()

    Dim sh1, sh2 As Worksheet

    Dim rng1, c As Range

   

    Set sh1 = ThisWorkbook.Worksheets("Foglio1")

    Set sh2 = ThisWorkbook.Worksheets("Foglio2")

    Set rng1 = sh1.Range("A1:Z20")

   

    For Each c In rng1

        If c.Value = 100 Then

            c.Copy Destination:=sh2.Cells(c.Row, c.Column)

        End If

    Next c

   

    Set sh1 = Nothing

    Set sh2 = Nothing

    Set rng1 = Nothing

           

End Sub

---

David

Ciao David. Medita per favore su questa cosa:

Public Sub m()

    Dim sh1, sh2 As Worksheet

    sh1 = 5  '<<===VALIDO

    MsgBox TypeName(sh1)

End Sub

Meglio, sempre:

Public Sub m()

    Dim sh1 As Worksheet

    Dim sh2 As Worksheet

    sh1 = 5  '<<===ERRORE

    MsgBox TypeName(sh1)

End Sub

E, visto che fai il set a nothing delle variabili oggetto(1), di c(che è Range), perchè no?

Quindi, solo più *robusta* della tua ottima routine:

Public Sub CopiaSparsa()

    Dim sh1 As Worksheet

    Dim sh2 As Worksheet

    Dim rng As Range

    Dim c As Range

    With ThisWorkbook

        Set sh1 = .Worksheets("Foglio1")

        Set sh2 = .Worksheets("Foglio2")

    End With

    With sh1

        Set rng = .Range("A1:Z20")

        For Each c In rng

             If c.Value = 10 Then

                 c.Copy Destination:=sh2.Range(c.Address)

             End If

         Next

    End With

    Set sh1 = Nothing

    Set sh2 = Nothing

    Set rng = Nothing

    Set c = Nothing

End Sub

Grazie per l'eventuale attenzione.

(1) Ricordo per chi legge(David immagino lo saprà sicuramente) che il Set a Nothing delle variabili oggetto *non è obbligatorio* in quanto all'uscita della routine Excel azzera i riferimenti agli oggetti. Io, però, lo faccio sempre(ma io, eh).

Answer 2

Ciao Fabrizio,

prova a vedere se questa ti è utile

---

Sub CopiaSparsa()

    Dim sh1, sh2 As Worksheet

    Dim rng1, c As Range

    Set sh1 = ThisWorkbook.Worksheets("Foglio1")

    Set sh2 = ThisWorkbook.Worksheets("Foglio2")

    Set rng1 = sh1.Range("A1:Z20")

    For Each c In rng1

        If c.Value = 100 Then

            c.Copy Destination:=sh2.Cells(c.Row, c.Column)

        End If

    Next c

    Set sh1 = Nothing

    Set sh2 = Nothing

    Set rng1 = Nothing

End Sub

---

David

Answer 3

Sono d'accordo ... grazie comunque ad entrambi per l'attenzione.

Ciao.

Grazie a te per il cortese riscontro e buon lavoro.