Raggruppare dati di diversi fogli su unico foglio

Question

Buongiorno, sto facendo alcune prove con CERCA.VERT e altre prove tutte con errori.

Spiego il problema, nel mio lavoro ho circa una decina di fogli excel, purtroppo non tutti incolonnati in modo uguale da cui prendere informazioni.

il foglio sono composti più o meno cosi: 

1     A                          B                    C                          D                                E             F

2 Codice           Descrizione         Cod ArM          Descrizione M             Consumo      UM

3 BB_M30          MC Sed 1920     00 Lam             Lamiera 10x20x1,5              12          Kg

4 BB_M30          MC Sed 1720     00 Lam             Lamiera 12x24x2                 19          Kg

5 BB_M30          MC Sed 1920     00 Las               Laser Taglio                      1,15          mn

6 BB_M30          MC Sed 1920     00 Sal               Sald. Robot G                      15          mn

Naturalmente le voci non sempre seguono questa logica, spesso trovo il laser per ultimo visto che sono solo i dati che servono alla lavorazione del componente.

Quello che devo riuscire a fare negli anni di vita che mi restano ( battuta ) e riuscire a leggere le voci per tipologia di questi files e caricare questi dati su unico foglio.

i fogli hanno lo stesso codice iniziale, cioe BB_M30, BB_M31, BB_M32 ecc, le voci che mi interessano sono A, D, E, F

Avevo iniziato un colosso = e caricavo la cella interessata, ma poi man mano mi passavano i fogli vedevo che queste posizioni cambiavano, quindi mi ritrovo con ore di lavoro inutili se non per altro di capire le voci interne.

Answer 1

Ciao David,

Buongiorno, sto facendo alcune prove con CERCA.VERT e altre prove tutte con errori.

Spiego il problema, nel mio lavoro ho circa una decina di fogli excel, purtroppo non tutti incolonnati in modo uguale da cui prendere informazioni.

il foglio sono composti più o meno cosi: 

1     A                          B                    C                          D                                E             F

2 Codice           Descrizione         Cod ArM          Descrizione M             Consumo      UM

3 BB_M30          MC Sed 1920     00 Lam             Lamiera 10x20x1,5              12          Kg

4 BB_M30          MC Sed 1720     00 Lam             Lamiera 12x24x2                 19          Kg

5 BB_M30          MC Sed 1920     00 Las               Laser Taglio                      1,15          mn

6 BB_M30          MC Sed 1920     00 Sal               Sald. Robot G                      15          mn

Naturalmente le voci non sempre seguono questa logica, spesso trovo il laser per ultimo visto che sono solo i dati che servono alla lavorazione del componente.

Quello che devo riuscire a fare negli anni di vita che mi restano ( battuta ) e riuscire a leggere le voci per tipologia di questi files e caricare questi dati su unico foglio.

i fogli hanno lo stesso codice iniziale, cioe BB_M30, BB_M31, BB_M32 ecc, le voci che mi interessano sono A, D, E, F

Avevo iniziato un colosso = e caricavo la cella interessata, ma poi man mano mi passavano i fogli vedevo che queste posizioni cambiavano, quindi mi ritrovo con ore di lavoro inutili se non per altro di capire le voci interne.

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IMper inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

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

Option Explicit

Public Const sFoglioRiepilogo As String = _

                                                        "Riepilogo"     '<<=== Modifica

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

Public Sub CreaRiepilogo()

    Dim WB As Workbook

    Dim Sh As Worksheet

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrDati As Variant

    Dim arrIntestazioni As Variant, arrColonne As Variant

    Dim i As Long, j As Long, iCtr As Long

    Dim LRow As Long, UB As Long

    Dim CalcMode As Long

    Const sIntestazioni As String = _

          "Codice,Descrizione M," _

          & "Consumo,UM"                                          '<<=== Modifica

    Const sColonne As String = _

                                "A:A,D:D,E:E,F:F"                     '<<=== Modifica

    Const sPrefissoCodice As String = "BB_M"         '<<=== Modifica

    arrIntestazioni = Split(sIntestazioni, ",")

    arrColonne = Split(sColonne, ",")

    UB = UBound(arrColonne) + 1

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    Set WB = ThisWorkbook

    With WB

        If SheetExists(sFoglioRiepilogo) Then

            Set destSH = .Sheets(sFoglioRiepilogo)

            With destSH

                .UsedRange.Offset(1).ClearContents

                .ListObjects(1).Delete

            End With

        Else

            Set destSH = .Sheets.Add

            With destSH

                .Name = sFoglioRiepilogo

                .Range("A1").Resize(1, UB).Value = arrIntestazioni

            End With

        End If

        For Each Sh In .Sheets

            With Sh

                If UCase(Left(.Name, Len(sPrefissoCodice))) = _

                                                              sPrefissoCodice Then

                    With .UsedRange

                        Set srcRng = .Offset(1).Resize(.Rows.Count - 1)

                    End With

                    Set srcRng = Intersect(srcRng, .Range(sColonne))

                    With destSH

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

                        Set destRng = .Range("A" & LRow + 1)

                    End With

                    srcRng.Copy Destination:=destRng

                End If

            End With

        Next Sh

    End With

    With destSH

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

        Set destRng = .Range("A" & LRow)

        Set destRng = .Range("A1").CurrentRegion

        destRng.EntireColumn.AutoFit

        .ListObjects.Add(xlSrcRange, destRng, , xlYes).Name = _

        "Tabella" & sFoglioRiepilogo

    End With

    Call MsgBox( _

         Prompt:="Finito!", _

         Buttons:=vbInformation, _

         Title:="REPORT")

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

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

Public Function LastRow(Sh As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

    With Sh

        If Rng Is Nothing Then

            Set Rng = .Cells

        End If

        bProtected = .ProtectContents = True

        If bProtected Then

            .Unprotect Password:=sPassword

        End If

    End With

    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

    If bProtected Then

        Sh.Protect Password:=sPassword, _

                   UserInterfaceOnly:=True

    End If

End Function

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

Public Function SheetExists(sSheetName As String, _

                            Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next

    If WB Is Nothing Then

        Set WB = ThisWorkbook

    End If

    SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))

    On Error GoTo 0

End Function

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

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file e incolla il seguente codice:

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

Option Explicit

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

Private Sub Workbook_SheetActivate(ByVal SH As Object)

    If SH.Name = sFoglioRiepilogo Then

        Call CreaRiepilogo

    End If

End Sub
'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester

Potresti scaricare il mio file di prova David20180301.xlsm

===

Regards,

Norman

Answer 2

Signor Norman lavoro straordinario, la ringrazio sia per la velocità nella risposta sia per il lavoro che ha creato, anche se per un errore di scrittura mio non ho indicato una cosa, i fogli non sono nella stessa cartella di lavoro di excel ( foglio1, foglio2, foglio2 ) ma dentro una cartella di lavoro di windows con il nome dell'azienda.

quindi mi trovo c:\dati\nomeazienda\prodotti\ e qui lavoro con i fogli excel.

Posso provare a modificare una uscita per leggere i singoli fogli excel nel files?

ho fatto alcune modifiche di prova con il codice da Lei creato, pero caricato troppi fogli rendo difficoltoso il lavoro di excel.

Quello che devo fare e riuscire a leggere queste 4 o 5 righe principali nei fogli esterni su un foglio separato in modo che posso avere sotto mano le informazioni che servono.

su ogni foglio ci sono almeno 22 informazioni su 7 colonne molte delle quali non mi interessano, il foglio da lei creato permette di aggiungere o togliere comodamente pero lavora nella stessa cartella excel

la ringrazio per eventuale risposta e per l'aiuto dato precedentemente.

saluti

Davide