Filtra, copia e incolla in un altro foglio di lavoro.

Question

Buona sera a tutti. 

Ho un foglio di lavoro chiamato Report su cui incollo dei dati provenienti da un altro file. 

I dati occupano le colonne da A a K e i dati su cui applicare il filtro è la colonna A. 

Con il vostro aiuto vorrei ottenere questo. 

1. filtrare i dati applicandolo sulla colonna A, inserendo il dato da filtrare in un MsgBox.
2. copiare tutti i dati Filtrati su di un altro foglio. 
3. effettuare nell'ultima cella delle colonne G ed F la somma dei valori in esse riportati. 

Per ora mi fermo qui, per non creare confusione. 

Spero di essere stato chiaro.

P.S. Poi spiego ulteriore routine finale per eseguire una ultima procedura. 

Ciao Nicola.

Answer 1

Ciao Nicola,

ho provato la tua routine e come sempre va benissimo.

Ho da chiederti questo:

1. è possibile fa uscire un MSGBOX quando non trova il dato da filtrare?

Ciò è necessario poiché i dati sono disposti in 6500 righe e in caso di errore di digitazione del dato da filtrare, desidererei essere avvisato che non esiste.

Prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range, foundRng As Range

    Dim Res As Variant

    Dim i As Long, j As Long

    Dim LRow As Long

    Dim bFound As Boolean

    Const sFoglio_Sorgente As String = "Report"                                 '<<=== Modifica

    Const sFoglio_Destinazione As String = "Foglio2"                         '<<=== Modifica

    Const sColonne As String = "A:K"                                                  '<<=== Modifica

    Const sDestinazione As String = "A1"                                            '<<=== Modifica

    Res = Application.InputBox( _

        Prompt:="Quale dipendente deve essere copiato?", _

        Title:="DIPENDENTE", _

        Type:=2)       

    Set WB = ThisWorkbook

    With WB

        Set srcSH = .Sheets(sFoglio_Sorgente)

        Set destSH = .Sheets(sFoglio_Destinazione)

    End With

    With srcSH

        Set foundRng = .Columns("A:A").Find( _

            What:=Res, _

            After:=.Range("A1"), _

            LookIn:=xlFormulas2, _

            LookAt:=xlWhole, _

            SearchOrder:=xlByRows, _

            SearchDirection:=xlNext, _

            MatchCase:=False, _

            SearchFormat:=False)

        If .AutoFilterMode Then

            .AutoFilterMode = False

        End If

        If foundRng Is Nothing Then

            destSH.Columns(sColonne).ClearContents

            Call MsgBox(Prompt:="Il dpendente " & Res & " non e' stato trovato!", _

            Buttons:=vbCritical, _

            Title:="ERRORE!")

            Exit Sub

        End If

        .Range("A1").AutoFilter _

        Field:=1, _

        Criteria1:=Res, _

        VisibleDropDown:=False

        Set srcRng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

    End With

    With destSH

        .Range(sColonne).ClearContents

        Set destRng = .Range(sDestinazione)

        srcRng.Copy Destination:=destRng

        LRow = LastRow(destSH, .Columns("A:A"))

        If LRow > 1 Then

            .Range("G" & LRow + 1).Value = Application.Sum(.Range("G2").Resize(LRow - 1))

            .Range("H" & LRow + 1).Value = Application.Sum(.Range("H2").Resize(LRow - 1))

        End If

    End With

    srcSH.AutoFilterMode = False

    Call MsgBox(Prompt:="Fatto", Buttons:=vbInformation, Title:="REPORT")

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

    Optional Rng As Range, _

    Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

        After:=Rng.Cells(1), _

        LookAt:=xlPart, _

        LookIn:=xlFormulas, _

        SearchOrder:=xlByRows, _

        SearchDirection:=xlPrevious, _

        MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========

===

Regards,

Norman

Answer 2

Ciao Norman, ho provato la tua routine e come sempre va benissimo.

Ho da chiederti questo:

1. è possibile fa uscire un MSGBOX quando non trova il dato da filtrare?

Ciò è necessario poiché i dati sono disposti in 6500 righe e in caso di errore di digitazione del dato da filtrare, desidererei essere avvisato che non esiste.

Grazie ancora per la tua disponibilità e gentilezza.

Ciao Nicola.

Answer 3

Ringrazio: Alessandro_Ga (mi interessa farlo con routine VBA e per questo seguo il consiglio di Norman)  e Norman per i  cortesi e opportuni suggerimenti.

Per Norman: sto eseguendo delle prove sui miei 2 files e ti aggiornerò su eventuali aggiustamenti e/o ulteriori richieste.

Ciao Nicola.

Answer 4

Ciao Nicola,

Ho un foglio di lavoro chiamato Report su cui incollo dei dati provenienti da un altro file. 

I dati occupano le colonne da A a K e i dati su cui applicare il filtro è la colonna A. 

Con il vostro aiuto vorrei ottenere questo. 

1. filtrare i dati applicandolo sulla colonna A, inserendo il dato da filtrare in un MsgBox.
2. copiare tutti i dati Filtrati su di un altro foglio. 
3. effettuare nell'ultima cella delle colonne G ed F la somma dei valori in esse riportati. 

Per ora mi fermo qui, per non creare confusione. 

Spero di essere stato chiaro.

P.S. Poi spiego ulteriore routine finale per eseguire una ultima procedura. 

Prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim Res As Variant

    Dim LRow As Long

    Const sFoglio_Sorgente As String = "Report"                 '<<=== Modifica

    Const sFoglio_Destinazione As String = "Foglio2"          '<<=== Modifica

    Const sColonne As String = "A:K "                                  '<<=== Modifica

    Const sDestinazione As String ="A1"                              '<<=== Modifica

    Res = Application.InputBox( _

        Prompt:="Quale dipendente deve essere copiato?", _

        Title:="DIPENDENTE", _

        Type:=2)

    Set WB = ThisWorkbook

    With WB

        Set srcSH = .Sheets(sFoglio_Sorgente)

        Set destSH = .Sheets(sFoglio_Destinazione)

    End With

    With srcSH

        If .AutoFilterMode Then

            .AutoFilterMode = False

        End If

        .Range("A1").AutoFilter _

        Field:=1, _

        Criteria1:=Res, _

        VisibleDropDown:=False

        Set srcRng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

    End With

    With destSH

        .Range(sColonne).ClearContents

        Set destRng = .Range(sDestinazione)

        srcRng.Copy Destination:=destRng

        LRow = LastRow(destSH, .Columns("A:A"))

        .Range("G" & LRow + 1).Value = Application.Sum(.Range("G2").Resize(LRow - 1))

        .Range("H" & LRow + 1).Value = Application.Sum(.Range("H2").Resize(LRow - 1))

    End With

    srcSH.AutoFilterMode = False

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

    Optional Rng As Range, _

    Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

        After:=Rng.Cells(1), _

        Lookat:=xlPart, _

        LookIn:=xlFormulas, _

        SearchOrder:=xlByRows, _

        SearchDirection:=xlPrevious, _

        MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========

===

Regards,

Norman

Answer 5

Ciao Nicola,

Eccomi qui, vediamo di approfondire la cosa insieme.

Per quello che riguarda tali funzionalità che vuoi aggiungere al tuo file "Report", hai già creato delle possibili Macro o formule?

Quanto descrivi sembra essere sicuramente interessante ma anche necessitare di un occhio esterno.

Vorrei a tal proposito consigliarti alcune cose da fare.

Per prima cosa ti vorrei lasciare un articolo che cita proprio i MsgBox, ovvero delle funzioni ottenibili tramite VBA.

MsgBox function (Visual Basic for Applications) | Microsoft Docs (in Inglese ma puoi utilizzare Bing Translator) Bing Microsoft Translator

Per quello che riguarda il copiare i file diltrati da un foglio a un altro, trattandosi di molti file potrebbe essere necessaria una Macro, ovvero una serie di azioni automatizzate.

Qui ti lascio come creare una Macro:

Guida introduttiva: creare una macro - Supporto di Office (microsoft.com)

Per quello che invece riguarda la somma tra le celle ti lascio questa formula: SOMMA (funzione SOMMA) - Supporto di Office (microsoft.com)

A proposito della creazione di formule, VBA o Macro però vorrei fornirti le indicazioni riguardo a una seconda Community, ovvero quella TechNet.

Questa è frequenatat da esperti nel campo IT e programmatori che hanno grandi conoscenze per quello che riguarda tali argomenti e la creazione di questi.

Ti consiglio quindi di scrivere direttamente lì eventuali dubbi che hai per la creazione dei codici per ottenere quanto desiderato.

Fammi sapere come va

Per ogni domanda o dubbio siamo qui

A presto,

Alessandro