Recórrer totes les fulles d'un llibre d'EXCEL i recuperar determinades dades que escriurem en una fulla que anomenarem resum amb Codi VBA insertat en un botó vinculat a una macro

Abans de res has de guardar el fitxer d'EXCEL en format .xlsm (Libro de Excel habilitado para macros)

 Després crearem un codi VBA per a Excel que fa el següent:

1. Recorre totes les fulles del llibre, excepte la fulla de recopilació (anomenada "Resum").

2. Busca dues dades en una fila i columna específica de cada fulla.

3. Escriu aquestes dades en una fila i columna específica de la fulla "Resum".

S'ha de crear un botó que activi aquest procés.

Com utilitzar el codi:

1. Obre l'editor de VBA a Excel (Alt + F11).

2. Crea un mòdul nou dins del teu llibre 
   
   

3. Enganxa el codi proporcionat. ( Veure al final del document )

4. Crea una fulla anomenada "Resum" per recopilar les dades.

5. Insereix un botó al full (Desenvolupador > Controls) i assigna-li la macro RecopilarDades.
   
   

   
   
   
   
   
   
   
   
   
   
   
   

6. Executa el botó per obtenir les dades de cada fulla.

El codi VBA per recopilar les dades que es troben en celes determinades és el següent:

Sub RecopilarDades()

    Dim ws As Worksheet

    Dim wsResum As Worksheet

    Dim filaResum As Long

    

    ' Definim la fulla de resum

    Set wsResum = ThisWorkbook.Sheets("Resum")

    

    ' Inicialitzem la fila on començarem a escriure les dades al resum

    filaResum = 2 ' Suposant que la fila 1 té els encapçalaments

    

    ' Netejar dades anteriors

    wsResum.Range("A2:B1000").ClearContents

    

    ' Recorrem totes les fulles del llibre

    For Each ws In ThisWorkbook.Sheets

        ' Ometem la fulla de resum

        If ws.Name <> "Resum" Then

            ' Inserim les dades de cada fulla al resum

            ' Exemples: cel·les A1 i B1 de cada fulla

            wsResum.Cells(filaResum, 1).Value = ws.Name ' Nom de la fulla

            wsResum.Cells(filaResum, 2).Value = ws.Range("A1").Value ' Primera dada

            wsResum.Cells(filaResum, 3).Value = ws.Range("B1").Value ' Segona dada

            

            filaResum = filaResum + 1 ' Passem a la següent fila

        End If

    Next ws

    

    MsgBox "Dades recopilades correctament!"

End Sub

El codi VBA per recopilar dades per nom és:

Sub RecopilarDadesPerNoms()

    Dim ws As Worksheet

    Dim wsResum As Worksheet

    Dim filaResum As Long

    Dim nom1 As String, nom2 As String

    Dim cel As Range

    

    ' Definim els noms a cercar

    nom1 = "TARGETA"  ' Substitueix per al primer nom concret

    nom2 = "FACTURA"  ' Substitueix per al segon nom concret

    

    ' Definim la fulla de resum

    Set wsResum = ThisWorkbook.Sheets("Resum")

    

    ' Inicialitzem la fila on començarem a escriure les dades al resum

    filaResum = 6 ' fila a partir de la qual començem a escriure la recopilació de dades

    

    ' Netejar dades anteriors

    wsResum.Range("A2:C1000").ClearContents

    

    ' Recorrem totes les fulles del llibre

    For Each ws In ThisWorkbook.Sheets

        ' Ometem la fulla de resum

        If ws.Name <> "Resum" Then

            ' Cerquem el primer nom a tota la fulla

            For Each cel In ws.UsedRange

                If cel.Value = nom1 Then

                

                    wsResum.Cells(filaResum, 1).Value = ws.Name

                    wsResum.Cells(filaResum, 2).Value = nom1 ' Nom trobat

                    wsResum.Cells(filaResum, 3).Value = ws.Range(cel.Offset(1, 0).Address) ' Adreça de la cel·la d'una fila més avall. Veure * NOTA 1

                    filaResum = filaResum + 1

                    

                ElseIf cel.Value = nom2 Then

                    wsResum.Cells(filaResum - 1, 4).Value = ws.Name

                    wsResum.Cells(filaResum - 1, 5).Value = nom2 ' Nom trobat

                    wsResum.Cells(filaResum - 1, 6).Value = ws.Range(cel.Offset(1, 0).Address) ' Adreça de la cel·la d'una fila més avall

                               

                End If

            

            Next cel

            

        End If

    Next ws

    

    MsgBox "Dades recopilades correctament!"

End Sub

* Nota 1: Per captar l'adreça de la cel·la una fila superior a una cel·la específica en VBA, pots fer servir aquesta sintaxi:

vba
cel.Offset(-1, 0).Address

Explicació:

• cel.Offset(-1, 0): Es desplaça una fila amunt i 0 columnes a la dreta/esquerra respecte a la cel·la original.

• .Address: Captura l'adreça d'aquesta nova cel·la.

Exemple d'implementació en el teu codi:

vba
wsResum.Cells(filaResum, 3).Value = cel.Offset(-1, 0).Address ' Adreça de la fila superior

✅ Nota: Assegura't que no estàs a la primera fila, o et donarà un error. Pots afegir una comprovació:

vba
If cel.Row > 1 Then
    wsResum.Cells(filaResum, 3).Value = cel.Offset(-1, 0).Address
Else
    wsResum.Cells(filaResum, 3).Value = "Primera fila"
End If