COPIARE ED INCOLLARE COLONNE FILTRATE

Question

Vorrei profittare della vostra competenza per una domandina:

una macro apparentemente semplice, ma non ci riesco.

Devo copiare la colonna E sulla colonna F, che sono filtrate, quindi copiare le celle visibili di E sulle celle visibili di F.

Non posso stabilire un range fisso, perchè il numero di celle può variare in funzione dei filtri.

Come fare?

Ciao!

Paolo

Answer 1

Ciao Paolo,

prova a vedere se così ci avviciniamo a quanto chiedi.

---

Sub Caso1()

    Dim sh As Worksheet

    Dim lRiga As Long

    Dim rng1 As Range

    Dim rng2 As Range

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        If .FilterMode Then

            lRiga = Split(.AutoFilter.Range.Address, "$")(4)

            Set rng1 = .Range(.Cells(2, 5), .Cells(lRiga, 5))

            For Each rng2 In rng1

                If Not Intersect(rng1.SpecialCells(xlCellTypeVisible), rng2) Is Nothing Then

                    rng2.Offset(, 1).Value = rng2.Value

                Else

                    rng2.Offset(, 1).ClearContents

                End If

            Next

        Else

            lRiga = .Range("E" & .Rows.Count).End(xlUp).Row

            Set rng1 = .Range(.Cells(2, 5), .Cells(lRiga, 5))

            rng1.Copy Destination:=rng1.Offset(, 1)

        End If

    End With

    Set sh = Nothing

    Set rng1 = Nothing

End Sub

Sub Caso2()

    Dim sh As Worksheet

    Dim lRiga As Long

    Dim rng1 As Range

    Dim rng2 As Range

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        If .FilterMode Then

            lRiga = Split(.AutoFilter.Range.Address, "$")(4)

            Set rng1 = .Range(.Cells(2, 5), .Cells(lRiga, 5))

            For Each rng2 In rng1

                If Not Intersect(rng1.SpecialCells(xlCellTypeVisible), rng2) Is Nothing Then

                    rng2.Offset(, 1).Value = .Range("Q1")

                Else

                    rng2.Offset(, 1).ClearContents

                End If

            Next

        Else

            lRiga = .Range("E" & .Rows.Count).End(xlUp).Row

            Set rng1 = .Range(.Cells(2, 6), .Cells(lRiga, 6))

            .Range("Q1").Copy Destination:=rng1

        End If

    End With

    Set sh = Nothing

    Set rng1 = Nothing

End Sub

---

David

Answer 2

La macro fa esattamente quello che chiedi: copia i valori filtrati (visibili) della colonna E nella colonna F.

 

David

 Mah... io dico che...

FUNZIONA MOLTO BENE!! GRAZIE DAVID!

Se invece volessi incollare il valore della cella Q1 su tutte le celle filtrate della colonna F  come dovrei modificare?

Grazie ancora

Pier Paolo

Answer 3

Grazie molte!

Prima di testarla, potresti modificarmi le colonne come nella domanda, cioè copia da colonna E a colonna F?

Così, vedendo le differenze, imparo un pò di sintassi. (sono agli inizi con VBA)

La macro fa esattamente quello che chiedi: copia i valori filtrati (visibili) della colonna E nella colonna F.

David

Answer 4

Grazie molte!

Prima di testarla, potresti modificarmi le colonne come nella domanda, cioè copia da colonna E a colonna F?

Così, vedendo le differenze, imparo un pò di sintassi. (sono agli inizi con VBA)

Answer 5

Ciao Paolo,

ipotizzando i tuoi dati nel foglio1, in range A1: xxxx (con intestazioni di colonna in riga 1) un modo consiste nel ciclare tra le celle visibili in questo modo:

---

Sub m()

    Dim sh As Worksheet

    Dim lRiga As Long

    Dim rng1 As Range

    Dim rng2 As Range

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        If .FilterMode Then

            lRiga = .Range("A" & .Rows.Count).End(xlUp).Row

            Set rng1 = .Range(.Cells(2, 5), .Cells(lRiga, 5))

            For Each rng2 In rng1.SpecialCells(xlCellTypeVisible)

                rng2.Offset(, 1).Value = rng2.Value

            Next

        End If

    End With

    Set sh = Nothing

    Set rng1 = Nothing

End Sub

---

David