Copiare righe da vari fogli excel a un determinato foglio

Question

Buon pomeriggio a tutt*,

ho cercato e ricercato soluzioni simili ma non ne vengo a capo.

Vi porgo il mio problema.

Ho un file excel con fogli di lavoro ognuno per ogni mese e altri fogli di lavoro, nei fogli di lavoro mensili ho una tabella e vorrei che per ogni foglio vengano copiate le righe in un nuovo foglio se una colonna delle varie tabelle (che sono tutte uguali) ha No all'interno. Oltre a questo nel nuovo foglio non servono tutte le colonne della tabella, ma solo alcune di queste. Inoltre, sarebbe utile ordinarle per data di scadenza e quando l'opzione passa da No a Si, si tolga l'intera riga.

Siccome è un po complicato spiegare metto il link di un file con dati fittizi e molto semplificata.

Vorrei che nel foglio Card18 vengano copiate solo le colonne riportate, che si trovano nelle tabelle Gen18, Feb18, Mar18.

Spero di essere stata chiara ma ne dubito :)

Grazie comunque per le eventuali risposte.

https://www.dropbox.com/s/g1zpgkoiio77qls/esempio.xlsx?dl=0

Answer 1

Ciao Eva,

Chiedo scusa perché ritorno tardivavamente alla tua domanda!

Prova a sostituire il codice precedente con la seguente versione:

'=========>>

Option Explicit

Option Compare Text

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

Public Sub Aggiorna_Card(aSH As Worksheet)

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim srcSH As Worksheet

    Dim srcRng As Range, deatRng As Range

    Dim LObj As ListObject

    Dim arrIn As Variant, arrOut() As Variant

    Dim arrColonne As Variant

    Dim Res As Variant

    Dim vVal As Variant

    Dim arrMese As Variant

    Dim aStr As String, bStr As String

    Dim i As Long, j As Long, k As Long

    Dim iCtr As Long, jCtr As Long, iCol As Long

    Dim bFlag As Boolean

    Const sColonne_Da_Copiare As String = _

                                             "1,2,4,6,7,8,9,10"       '<<=== Modifica

    Const iColonna_Attivata As Long = 13               '<<=== Modifica

    Const sPrefisso As String = "Card_"                     '<<=== Modifica

    Set WB = ThisWorkbook

    arrMese = Application.GetCustomListContents(3)

    arrColonne = Split(sColonne_Da_Copiare, ",")

    For Each SH In WB.Worksheets

        With SH

            aStr = .Name

            bStr = Left(aStr, 3)

            Res = Application.Match(bStr, arrMese, 0)

            If Not IsError(Res) Then

                Set srcRng = .ListObjects(sPrefisso & aStr).DataBodyRange

                arrIn = srcRng.Value2

                For i = LBound(arrIn) To UBound(arrIn)

                    If arrIn(i, iColonna_Attivata) = "NO" Then

                        iCtr = iCtr + 1

                        ReDim Preserve arrOut(1 To 8, 1 To iCtr)

                        For j = LBound(arrColonne) To UBound(arrColonne)

                            jCtr = jCtr + 1

                            iCol = arrColonne(jCtr - 1)

                            vVal = arrIn(i, iCol)

                            arrOut(jCtr, iCtr) = vVal

                        Next j

                        jCtr = 0

                    End If

                Next i

            End If

        End With

    Next SH

    bFlag = CBool(iCtr)

    If bFlag Then

        arrOut = Application.Transpose(arrOut)

    End If

    With aSH.ListObjects(1)

        If Not .DataBodyRange Is Nothing Then

            .DataBodyRange.Delete

        End If

        If bFlag Then

            .HeaderRowRange.Offset(1). _

                    Resize(UBound(arrOut)).Value2 = arrOut

            .Range.Sort key1:=.ListColumns(4), _

                        order1:=xlAscending, _

                        Header:=xlYes, _

                        OrderCustom:=1, _

                        MatchCase:=False, _

                        Orientation:=xlTopToBottom

        End If

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao evoich8,

ho cercato e ricercato soluzioni simili ma non ne vengo a capo.

Vi porgo il mio problema.

Ho un file excel con fogli di lavoro ognuno per ogni mese e altri fogli di lavoro, nei fogli di lavoro mensili ho una tabella e vorrei che per ogni foglio vengano copiate le righe in un nuovo foglio se una colonna delle varie tabelle (che sono tutte uguali) ha No all'interno. Oltre a questo nel nuovo foglio non servono tutte le colonne della tabella, ma solo alcune di queste. Inoltre, sarebbe utile ordinarle per data di scadenza e quando l'opzione passa da No a Si, si tolga l'intera riga.

Siccome è un po complicato spiegare metto il link di un file con dati fittizi e molto semplificata.

Vorrei che nel foglio Card18 vengano copiate solo le colonne riportate, che si trovano nelle tabelle Gen18, Feb18, Mar18.

Spero di essere stata chiara ma ne dubito :)

Grazie comunque per le eventuali risposte.

https://www.dropbox.com/s/g1zpgkoiio77qls/esempio.xlsx?dl=0

Prova qualcosa del genere:

• Fai clic dx sulla linguetta del foglio Card18
• Seleziona l'opzione Visualizza Codice dal menu contestuale risultante
• Incolla il seguente codice:

'=========>>

Option Explicit

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

Private Sub Worksheet_Activate()

    Call Aggiorna_Card(Me)

End Sub

'<<=========

• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

Option Compare Text

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

Public Sub Aggiorna_Card(aSH As Worksheet)

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim srcSH As Worksheet

    Dim srcRng As Range, deatRng As Range

    Dim LObj As ListObject

    Dim arrIn As Variant, arrOut() As Variant

    Dim arrColonne As Variant

    Dim Res As Variant

    Dim arrMese As Variant

    Dim aStr As String, bStr As String

    Dim i As Long, j As Long, k As Long

    Dim iCtr As Long, jCtr As Long, iCol As Long

    Const sPrefix As String = "Card"

    Const sColonne_Da_Copiare As String = "1,2,4,5,7,9"

    Set WB = ThisWorkbook

    arrMese = Application.GetCustomListContents(3)

    arrColonne = Split(sColonne_Da_Copiare, ",")

    For Each SH In WB.Worksheets

        With SH

            aStr = .Name

            bStr = Left(aStr, 3)

            Res = Application.Match(bStr, arrMese, 0)

            If Not IsError(Res) Then

                Set srcRng = .ListObjects(1).DataBodyRange

                arrIn = srcRng.Value

                '                jCtr = 0

                For i = LBound(arrIn) To UBound(arrIn)

                    If arrIn(i, 9) = "NO" Then

                        iCtr = iCtr + 1

                        ReDim Preserve arrOut(1 To 6, 1 To iCtr)

                        For j = LBound(arrColonne) To UBound(arrColonne)

                            jCtr = jCtr + 1

                            iCol = arrColonne(jCtr - 1)

                            If iCol = 3 Or iCol = 4 Then

                                arrOut(jCtr, iCtr) = CLng(arrIn(i, iCol))

                            Else

                                arrOut(jCtr, iCtr) = arrIn(i, iCol)

                            End If

                        Next j

                        jCtr = 0

                    End If

                Next i

            End If

        End With

    Next SH

    arrOut = Application.Transpose(arrOut)

    With aSH.ListObjects(1)

        If Not .DataBodyRange Is Nothing Then

            .DataBodyRange.Delete

        End If

        .HeaderRowRange.Offset(1). _

                Resize(UBound(arrOut)).Value2 = arrOut

        .Range.Sort key1:=.ListColumns(4), _

                    order1:=xlAscending, _

                    Header:=xlYes, _

                    OrderCustom:=1, _

                    MatchCase:=False, _

                    Orientation:=xlTopToBottom

    End With

End Sub

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm

Ogni volta che il foglio Card18 venga selezionato, i dai nella sua tabella verranno automaticamente aggiornati.

Potresti scaricare il mio file di prova Evoich20180806.xlsm

===

Regards,

Norman

Answer 3

Ciao Eva,

mi scuso  [...]

Non è affatto necessario scusarti o giustificarti! Stai tranquillo, io non sono affatto arrabiato - voglio solo fornirti una soluzione funzionante ed efficiente!

non credevo fosse fondamentale il contenuto delle celle della tabella. E non trovo così diversi i file, ma mi fido.

Per ottenere il meglio assistenza, penso che sia meglio sempre divulgare tutto tranne, ovviamennte, dati sensibil. Visitando il dottore, sarebbe meglio non solo riportare il mal di testa ma anche lo strano nodulo sul gomito: il nodulo potrebbe non avere rilevanza o potrebbe essere di importanza cruciale e fondamentale!

Sto imparando un po di Macro e VBA e pensavo con una "spintarella" da qualcuno più esperto di poter risolvere il problema riscontrato.

Sono solo quell'esperto quando la mia sfera di cristallo mi consente di vedere i noduli nascosti! :-)

Mi scuso nuovamente se ho fatto perdere tempo e pazienza.

Macché scusa! Sono io che devo scusarmi in quanto, rispondendo in fretta e non essendo in grado di esprimermi nella tua lingua pienamente nel modo che vorrei, ho trascurato le sfumature non volute nella mia risposta e quindi ho  lasciato l'impressione di essere infastidito! ((:-

Non ho capito molto questo passaggio, in particolare cosa c'è in ciascun foglio che:

"Più in particolare, il messaggio di errore che hai riscontrato è dovuto alla presenza su ciascuno dei fogli mensili di altre tabelle di Excel, un fatto significativo che non hai rivelato."

Intendevo solo sottolineare il fatto che poiché non ero a conoscenza della presenza di altre tabelle di Excel, il mio codice gestisce la prima tabella sui fogli mensili e, sfortunatamente, queste sono le tabelle Crediti piuttosto che le tabelle Card richieste! 

Comunque, l'ultimo file che ho inviato è l'originale senza dati sensibili. Inoltre ci sono fogli nascosti di mesi che ovviamente devono ancora arrivare e che attiverò successivamente e disattiverò gli altri ormai passati.

Benissimo! Devo uscire ora per mangiare con gli amici ma stasera, appena possibile, posterò un codice aggiornato

===

Regards,

Norman

Answer 4

Ciao,

mi scuso non credevo fosse fondamentale il contenuto delle celle della tabella. E non trovo così diversi i file, ma mi fido.

Sto imparando un po di Macro e VBA e pensavo con una "spintarella" da qualcuno più esperto di poter risolvere il problema riscontrato.

Mi scuso nuovamente se ho fatto perdere tempo e pazienza.

Non ho capito molto questo passaggio, in particolare cosa c'è in ciascun foglio che:

"Più in particolare, il messaggio di errore che hai riscontrato è dovuto alla presenza su ciascuno dei fogli mensili di altre tabelle di Excel, un fatto significativo che non hai rivelato."

Comunque, l'ultimo file che ho inviato è l'originale senza dati sensibili. Inoltre ci sono fogli nascosti di mesi che ovviamente devono ancora arrivare e che attiverò successivamente e disattiverò gli altri ormai passati.

Answer 5

Ciao Eva,

Ciao,

ho provato con il codice nuovo ma continua a darmi l'errore a questa riga:

    If arrIn(i, iColonna_Attivata) = "NO" Then

    [...]

Ho fatto un po' di tentativi per non disturbarti ulteriormente ma non riesco ad andare avanti.

Ti lascio il link al file originale in cui ho cancellato e cambiato dati sensibili. Il file ha la macro che mi hai dato.

https://www.dropbox.com/s/63d5ugnhlvcdm3l/Esempio%20con%20Macro.xlsm?dl=0

Il problema riscontrto da te è molto facilmente spiegato!

Purtroppo, la mia sfera di cristallo è in attesa della riparazione e, nella sua tanto mancata assenza, lo trovo molto difficile gestire o prevedere una struttura di dati totalmente diversa da quella descritta o illustrata nei file precedenti che hai caricato! :-)

Più in particolare, il messaggio di errore che hai riscontrato è dovuto alla presenza su ciascuno dei fogli mensili di altre tabelle di Excel, un fatto significativo che non hai rivelato.

Ulteriori problemi sono probabili, dovuti al fatto che, al posto delle date, alcune delle tabelle mensili includono valori di voci come IMM.

In breve, prima di gestire questi e altri eventuali problemi, vorrei essere sicuro che il tuo ultimo file sia pienamente rappresentativo della tua vera struttura dati. A questo proposito vorrei ricordati dello recente scambio:

Eva:

Un consiglio su come posso adattare il codice? 

Norman:

Senza conoscenza della disposizione dei dati nel file vero, credo sia davvero molto difficile offrirti consigli utili

[...]

===

Regards,

Norman