creazione Macro per estrazione dati su filtro dinamico

Question

buongiorno, 

avrei bisogno di una mano per la seguente situazione: ho un foglio "Monitoraggio" che contiene al suo interno qualche migliaio di record composto da 19 colonne. in colonna 14 "ABC" sono presenti le informazioni (ca.40) su cui devo applicare il filtro e generare un nuovo foglio excel con nome "lista di lavorazione_xxxx_filtro applicato" dove XXXX è la data del giorno di creazione del file e filtro applicato è uguale al valore in colonna "ABC" per cui il filtro è stato applicato.

se possibile la formattazione del foglio di arrivo deve essere uguale a quella di partenza. Potete aiutarmi?

grazie mille

Answer 1

Ciao,

prova a vedere se qualcosa del genere funziona con la tua "tabella".

Si basa sulla "current region" del database e sul "semplice" copia /incolla speciale.

Ci possono essere dei limiti con i filtri per il numero di "sezioni" da copiare e incollare e quindi è da verificare con la situazione reale.

Vedi questo file di esempio: File esempio

Questo il codice VBA presente nel Modulo1

Option Explicit

Const sPrimaCellaTabella As String = "A3"

Const sNomeWsTabella As String = "Monitoraggio"

Const iColonnaFiltro As Long = 14

Sub CreaListaLavorazioneFiltrata()

  Dim Twb As Workbook

  Dim WsTabella As Worksheet

  Dim rngTabella As Range

  Dim WbListaLavorazioneFiltrata As Workbook

  Dim strData As String

  Dim strFiltroApplicato As String

  Dim sPath As String

  Set Twb = ThisWorkbook

  Set WsTabella = Twb.Worksheets(sNomeWsTabella)

  With Application

    .ScreenUpdating = False

    .DisplayAlerts = False

  End With

  On Error GoTo Esci

  With WsTabella

    If .FilterMode = True Then

      Set rngTabella = WsTabella.Range(sPrimaCellaTabella).CurrentRegion

      Set WbListaLavorazioneFiltrata = Workbooks.Add(1)

      With WbListaLavorazioneFiltrata

        With .Worksheets(1)

          .Name = "Lista Filtrata"

          rngTabella.Copy '.Range(sPrimaCellaTabella)

          With .Range(sPrimaCellaTabella)

            .PasteSpecial xlPasteColumnWidths

            .PasteSpecial xlPasteFormats

            .PasteSpecial xlPasteValues

            .Select

          End With

          strFiltroApplicato = .Range(sPrimaCellaTabella).Offset(1, iColonnaFiltro - 1).Value

        End With

        sPath = ThisWorkbook.Path & ""

        strData = Format(Date, "yyyymmdd")

        .SaveAs Filename:=sPath & _

                          "Lista_di_lavorazione_" & _

                           strData & "_filtro_applicato_" & _

                           strFiltroApplicato & ".xlsx", _

                           FileFormat:=xlOpenXMLWorkbook

      End With

    Else

      MsgBox "Prima di creare la lista di lavorazione impostare un filtro sul tipo di lavorazione!", vbExclamation, "Crea Lista Lavorazione Filtrata"

    End If

  End With

RiprendiErrore:

  With Application

    .ScreenUpdating = True

    .DisplayAlerts = True

  End With

  Exit Sub

Esci:

  MsgBox "Errore n. " & Err.Number & vbCrLf & _

         Err.Description, vbCritical, "Errore!"

    GoTo RiprendiErrore

End Sub