Sviluppare funzionalita su Microsoft Office con VBA MACRO CERCA VALORE IN UN FILE E COPIA 4 celle adiacenti

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 32 totali)
  • Autore
    Articoli
  • #18839 Score: 0 | Risposta

    warp
    Partecipante

      salve, sono nuovo del forum, e nuovo di VBA.

      Ho la necessità di cercare un valore della colonna B del FILEMASTER.xls all'interno di un secondo file (in questo caso fogliocassaxyz.xls che avrà nomi differenti giornalmente) e se presente il valore copiare le celle da B ad E adiacenti nel FILEMASTER

      Vi allego i 2 file con i valori del file fogliocassaxyz.xls incollati manualmente nel filemaster.xls

      Sarebbe ottimale per automatizzare il tutto inserire un pulsante nel foglio filemaster.xls e che vada a cercare i valori della colonna B in tutti i file (fogliocassa) con nomi differenti che magari carico dentro una cartella chiamata "controllo".

      In allegato i due file
      spero di essere stato chiaro, nel caso rispiego in fase di discussione

       

       

       

      Allegati:
      You must be logged in to view attached files.
      #18946 Score: 1 | Risposta

      DeletedUser
      Bloccato
        13 pts

        Scusa, ma la macro già presente RiportaDatiCliente che scopo avrebbe?

        #18947 Score: 0 | Risposta

        warp
        Partecipante

          gibra ha scritto:

          Scusa, ma la macro già presente RiportaDatiCliente che scopo avrebbe?

          Ciao gibra, è una macro che non ha nessuno scopo, l'avevo creata per altre cose e dimenticata li. Mi è sfuggito cancellarla, scusami. 

          #18953 Score: 1 | Risposta

          DeletedUser
          Bloccato
            13 pts

            Però serviva allo stesso scopo. Io l'ho corretta ed ora funziona bene.

            Ti ri-allego i file, esegui la macro e vedi...

            N.B Per errore ho allegato due file uguali, ed il forum non mi consente di toglierli (e non capisco il perché) anzi me li ha numerati (Mah). Buttane uno e togli il numero finale (altrimenti la macro va in errore).

             

            Allegati:
            You must be logged in to view attached files.
            #18962 Score: 0 | Risposta

            warp
            Partecipante

              gibra ha scritto:

              Però serviva allo stesso scopo. Io l'ho corretta ed ora funziona bene.

              Grazie gibra. si così funziona, però non è quello che intendevo io.

              Mi spiego meglio.
              Giornalmente si ricevono 12 file di fogli cassa, ognuno con nomi differenti. Il mio obiettivo è quello magari di scaricare i 12 file dentro una cartella, magari chiamata "import", poi la macro va ad aprire tutti i file .xls (qualsiasi nome essi abbiano) che si trovano all'interno di "import" e deve fare un copia/incolla dei valori che fa nella ricerca, in quanto al termine i 12 file verranno eliminati e rimpiazzati il giorno successivo da altri 12 con altrettanti nomi differenti, quindi se possibile, fare in modo che vada ad analizzare tutti i file .xls che decideremo di mettere preventivamente dentro una cartella, come detto sopra "import".

              Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.

              Scusami se non mi sono spiegato in anticipo prima, ma il copia/incolla in questo caso è essenziale compresa la ricerca sui file .xls qualsiasi nome essi ebbiano. 

              Grazie sempre in anticipo. 

               

              #18964 Score: 1 | Risposta

              DeletedUser
              Bloccato
                13 pts

                warp ha scritto:

                Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.

                Scusa, ma adesso cosa c'entra il Copia&Incolla?

                Spiegati meglio perché la macro:

                1. non fa alcun CERCA.VERT
                2. non fa il Copia&Incolla

                La macro fa esattamente quello che hai chiesto all'inizio, vuol dire che non deve farlo?
                Allora perché l'hai chiesto?
                Non capisco...

                 

                #18965 Score: 0 | Risposta

                warp
                Partecipante

                  gibra ha scritto:

                  warp ha scritto:

                  Una sorta di "CERCA.VERT" nel mio caso non mi serve, ma fare un vero e proprio copia/incolla.

                  Si gibra, scusami... non sono ferrato su VBA, abbi pietà di me .. allora, la macro fa egregiamene il suo dovere... ma in questo caso solo sul file "fogliocassaxyz.xls"

                  è possibile modificarla, facendogli fare la ricerca non sul file specifico "fogliocassaxyz.xls" ma su tanti file "*.xls" che preventivamente vado a mettere dentro una cartella(directory) chiamata "import"?

                  esempio: io domani ricevo via mail 12 file
                  fogliocassaabcd.xsl
                  fogliocassa1234.xsl
                  fogliocassa8876.xsl
                  cassa1.xsl
                  cassa3.xls
                  etc... con nomi differenti
                  Vorrei che la macro andasse ad analizzare tutti questi file, che giornalmente avranno nomi differenti. Alla fine del lavoro, la cartella(directory) "import" verrà svuotata manualmente cancellando i file, così da riempirla l'indomani dagli altri file dei fogli cassa.

                  Ti chiedo ancora scusa.. è possibile fare una cosa del genere?

                  #18987 Score: 1 | Risposta

                  DeletedUser
                  Bloccato
                    13 pts

                    Allora modifica la macro così:

                    Sub RiportaDatiCliente()
                        Dim wbData As Workbook
                        Dim wsData As Worksheet
                        Dim rCel As Range
                        Dim sFolderName As String, sBookName As String
                        Dim lColonnaRicerca As Long, lLastRow As Long
                        Dim bOpened As Boolean
                        Dim vRow As Variant, vCode As Variant
                        Dim i As Long
                    
                        '--- parametri ricerca da modifcare
                        sFolderName = ThisWorkbook.Path & "\"
                        '///sBookName = "fogliocassaXYZ.xls"    '//"SUB 123_19.xls"
                        lColonnaRicerca = 3   ' corretto (era 2)
                        '----------------------------------------------
                    
                        Application.ScreenUpdating = False
                        '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso
                        
                        
                        Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE
                        sBookName = Dir$(sFolderName & "fogliocassa*.xls")
                        Do While sBookName <> ""
                            bOpened = False
                    
                            ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo
                            On Error Resume Next      
                            Set wbData = Workbooks(sBookName)
                            If wbData Is Nothing Then
                                Set wbData = Workbooks.Open(sFolderName & sBookName, , True)
                                bOpened = True
                                Err.Clear
                            End If
                            On Error GoTo 0
                            'On Error GoTo Uffa
                            ' ora il file è aperto, procedo alla lettura dei dati
                        
                            '--- modifica il nome del foglio nel quale effettuare la ricerca
                            Set wsData = wbData.Worksheets("Foglio1")
                        
                            '--- modifica il nome del foglio che contiene i codici da ricercare
                            With ThisWorkbook.Worksheets("Foglio1")
                                '--- i codici si trovano in colonna B
                                lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row
                                For i = 1 To lLastRow
                                    vCode = .Cells(i, 2)
                                    'If vCode = 23797 Then Stop
                                    If Len(vCode) Then
                                        vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0)
                                        If Not IsError(vRow) Then
                                            '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay
                                            .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value
                                        Else
                                            '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found")
                                        End If
                                    End If
                                Next i
                            End With
                            
                            wbData.Close False  ' chiudo il file
                            Set wbData = Nothing
                            sBookName = Dir$()  ' leggo il prossimo
                        Loop
                        
                    ExitHere:
                        Application.ScreenUpdating = True
                        On Error Resume Next
                        If bOpened Then wbData.Close False
                    
                        Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing
                        Exit Sub
                    
                    Uffa:
                        Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _
                                    CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _
                                    "Codice in elaborazione: " & vCode, _
                                    vbCritical + vbOKOnly, "Error message")
                        Resume ExitHere
                    End Sub
                    
                    #18992 Score: 0 | Risposta

                    warp
                    Partecipante

                      gibra ha scritto:

                      Allora modifica la macro così:

                      GRANDIOSO LAVORO!!! 
                      ho fatto una correzzione impostando una cartella dove andrò a mettere i file, chiamata "\controllo\"

                      '--- parametri ricerca da modifcare
                          sFolderName = ThisWorkbook.Path & "\controllo\"
                          '///sBookName = "fogliocassaXYZ.xls"    '//"SUB 123_19.xls"
                          lColonnaRicerca = 3   ' corretto (era 2)
                          '----------------------------------------------

                      e poi ho impostato che deve aprire tutti i file xls

                      Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE
                      sBookName = Dir$(sFolderName & "*.xls")
                      Do While sBookName <> ""
                      bOpened = False

                      e funziona alla grande!!!!

                      P.S.

                      domandona: nel caso volessi aggiungere al filemaster.xls altri fogli con altri codici da cercare...
                      quindi: foglio2 - foglio 3 - foglio 4 etc...
                      lascio tutto così ed eseguo la macro per ogni singolo foglio o devo specificare qualcosa nella macro?

                      ho allegato il file con le mie modifiche, se devi fare delle prove, crea la directory "controllo" per i file da controllare

                      Allegati:
                      You must be logged in to view attached files.
                      #18998 Score: 0 | Risposta

                      DeletedUser
                      Bloccato
                        13 pts

                        warp ha scritto:

                        nel caso volessi aggiungere al filemaster.xls altri fogli con altri codici da cercare... quindi: foglio2 - foglio 3 - foglio 4 etc...
                        lascio tutto così ed eseguo la macro per ogni singolo foglio o devo specificare qualcosa nella macro?

                        Dopo aver aperto il file la macro esegue

                        Set wsData = wbData.Worksheets("Foglio1")

                        devi sostituire questa istruzione inserendola dentro un ciclo che esamini ogni foglio di wbData:

                        Dim sh As Worksheet
                        For Each sh in wbData.Sheets
                            Set wsData = sh
                        
                            ' il resto del codice che hai già non cambia
                        Next
                        #19030 Score: 0 | Risposta

                        warp
                        Partecipante

                          gibra ha scritto:

                          Dopo aver aperto il file la macro esegue

                          Set wsData = wbData.Worksheets("Foglio1")

                          devi sostituire questa istruzione inserendola dentro un ciclo che esamini ogni foglio di wbData:

                          Dim sh As WorksheetFor Each sh in wbData.Sheets    Set wsData = sh    ' il resto del codice che hai già non cambiaNext

                          Ciao gibra, non capisco come fare, mi potresti postare l'intero codice fatto magari per 3 fogli inseriti su filemaster.xls? poi capendo come hai scritto il codice aggiungo gli altri fogli io personalizzandolo. 

                           

                          #19039 Score: 0 | Risposta

                          DeletedUser
                          Bloccato
                            13 pts

                            warp ha scritto:

                            Ciao gibra, non capisco come fare

                            Te l'ho scritto, segui le mie istruzioni.

                            Dai, su, un po' di intraprendenza!!!  

                            Una volta modificato, se hai problemi, ri-pubblica il file master con le tue modifiche e vediamo.

                            #19085 Score: 0 | Risposta

                            warp
                            Partecipante

                              gibra ha scritto:

                              '--- modifica il nome del foglio che contiene i codici da ricercare With ThisWorkbook.Worksheets("Foglio1") '

                              --- i codici si trovano in colonna B

                              Gibra, dalla modifica che mi hai proposto, ho "intuito" che la ricerca la fa ciclica sui fogli1 etc dei file che ricevo via mail...
                              Quello che intendevo io invece riguarda i fogli che contengono i codici da ricercare .. 
                              In allegato ti metto il file "filemaster.xls" con l'aggiunta di altri 2 fogli con codici da cercare.
                              In allegato ti metto pure i 2 file test da mettere dentro la directory "controllo" con l'aggiunta dei codici che si trovano nei 3 fogli del filemaster. 
                              Infatti ho provato a cambiare il codice
                              ThisWorkbook.Worksheets("Foglio1")  in  ThisWorkbook.Worksheets("Foglio2")  e mi trova i codici del foglio2 ...

                              io volevo questo, cercare i codici non soltanto nel foglio1 del filemaster.xls ma anche nel foglio2, 3, etc... o meglio ancora in tutta la cartella del filemaster.xls 

                               

                              Allegati:
                              You must be logged in to view attached files.
                              #19089 Score: 0 | Risposta

                              DeletedUser
                              Bloccato
                                13 pts

                                Mostra il codice modificato del file master, come ti ho spiegato di fare.

                                #19090 Score: 0 | Risposta

                                warp
                                Partecipante

                                  gibra ha scritto:

                                  Mostra il codice modificato del file master, come ti ho spiegato di fare.

                                  Sub RiportaDatiCliente()
                                      Dim wbData As Workbook
                                      Dim wsData As Worksheet
                                      Dim rCel As Range
                                      Dim sFolderName As String, sBookName As String
                                      Dim lColonnaRicerca As Long, lLastRow As Long
                                      Dim bOpened As Boolean
                                      Dim vRow As Variant, vCode As Variant
                                      Dim i As Long
                                  
                                      '--- parametri ricerca da modifcare
                                      sFolderName = ThisWorkbook.Path & "\controllo\"
                                      '///sBookName = "fogliocassaXYZ.xls"    '//"SUB 123_19.xls"
                                      lColonnaRicerca = 3   ' corretto (era 2)
                                      '----------------------------------------------
                                  
                                      Application.ScreenUpdating = False
                                      '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso
                                      
                                      
                                      Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE
                                      sBookName = Dir$(sFolderName & "*.xls")
                                      Do While sBookName <> ""
                                          bOpened = False
                                  
                                          ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo
                                          On Error Resume Next
                                          Set wbData = Workbooks(sBookName)
                                          If wbData Is Nothing Then
                                              Set wbData = Workbooks.Open(sFolderName & sBookName, , True)
                                              bOpened = True
                                              Err.Clear
                                          End If
                                          On Error GoTo 0
                                          'On Error GoTo Uffa
                                          ' ora il file è aperto, procedo alla lettura dei dati
                                      
                                          '--- modifica il nome del foglio nel quale effettuare la ricerca
                                          
                                          Dim sh As Worksheet
                                  For Each sh In wbData.Sheets
                                      Set wsData = sh
                                  Set wsData = wbData.Worksheets("Foglio1")
                                  Set wsData = wbData.Worksheets("Foglio2")
                                  Set wsData = wbData.Worksheets("Foglio3")
                                  Next
                                          
                                        
                                          
                                          
                                          '--- modifica il nome del foglio che contiene i codici da ricercare
                                          With ThisWorkbook.Worksheets("Foglio1")
                                              '--- i codici si trovano in colonna B
                                              lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row
                                              For i = 1 To lLastRow
                                                  vCode = .Cells(i, 2)
                                                  'If vCode = 23797 Then Stop
                                                  If Len(vCode) Then
                                                      vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0)
                                                      If Not IsError(vRow) Then
                                                          '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay
                                                          .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value
                                                      Else
                                                          '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found")
                                                      End If
                                                  End If
                                              Next i
                                          End With
                                          
                                          wbData.Close False  ' chiudo il file
                                          Set wbData = Nothing
                                          sBookName = Dir$()  ' leggo il prossimo
                                      Loop
                                      
                                  ExitHere:
                                      Application.ScreenUpdating = True
                                      On Error Resume Next
                                      If bOpened Then wbData.Close False
                                  
                                      Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing
                                      Exit Sub
                                  
                                  Uffa:
                                      Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _
                                                  CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _
                                                  "Codice in elaborazione: " & vCode, _
                                                  vbCritical + vbOKOnly, "Error message")
                                      Resume ExitHere
                                  End Sub
                                  

                                  questo è quello che ho sostituito in base alle tue spiegazioni (ripeto che non mi intendo di codice vba) ..

                                  Io non voglio modificare il nome del foglio nel quale effettuare la ricerca...

                                  ma voglio modificare il nome del foglio che contiene i codici da ricercare...

                                   '--- modifica il nome del foglio che contiene i codici da ricercare
                                          With ThisWorkbook.Worksheets("Foglio1")

                                  infatti modificando quanto sopra in ("Foglio2") lui mi cerca i codici del Foglio2 dentro tutti i file xls che si trovano dentro la directory controllo.

                                  #19092 Score: 0 | Risposta

                                  DeletedUser
                                  Bloccato
                                    13 pts

                                    warp ha scritto:

                                    ripeto che non mi intendo di codice vba

                                    Come?

                                    Scusa, ma allora la macro che c'era nel foglio (che io ho corretto) chi l'ha scritta?

                                    #19093 Score: 0 | Risposta

                                    warp
                                    Partecipante

                                      Gibra, una delle tante prove su codici che avevo trovato .. che serviva allo scopo ma non capendo nulla di Vba non capivo gli errori...

                                      ora con te inizio a leggiucchiare Vba e capire come funziona ... certo non sono a zero di informatica.. sono zero di Vba.. 

                                      #19100 Score: 1 | Risposta

                                      DeletedUser
                                      Bloccato
                                        13 pts

                                        Comunque tu hai scritto tutt'altra cosa da quello che ti ho indicato io.

                                        Rileggi bene e con calma il codice che ti ho scritto, quello che hai aggiunto tu non so a cosa serva!
                                        La parte di codice sotto è completamente inutile, non serve a nulla e non capisco perché tu l'abbia aggiunta:

                                        `For Each sh In wbData.Sheets
                                            Set wsData = sh
                                        Set wsData = wbData.Worksheets("Foglio1")
                                        Set wsData = wbData.Worksheets("Foglio2")
                                        Set wsData = wbData.Worksheets("Foglio3")
                                        Next`

                                        Sembra che tu stia scrivendo codice a casaccio.

                                        Devi fare il DEBUG del tuo codice, altrimenti non imparerai mai a sviluppare.

                                        #19103 Score: 0 | Risposta

                                        warp
                                        Partecipante

                                          gibra ha scritto:

                                          Sembra che tu stia scrivendo codice a casaccio.

                                          Devi fare il DEBUG del tuo codice, altrimenti non imparerai mai a sviluppare.

                                          Inizierò a studiarmi il vba. 

                                          grazie gentilissimo. 

                                          #19105 Score: 1 | Risposta

                                          DeletedUser
                                          Bloccato
                                            13 pts

                                            Imparare a fare il DEBUG è ancora più importante perché ti aiuta ad analizzare il codice, capire gli errori e come risolverli.

                                            Eccoti alcuni link, ma se fai una ricerca DEBUG VBA EXCEL trovi un sacco di materiale:

                                            https://www.excel-easy.com/vba/examples/debugging.html
                                            https://www.techonthenet.com/excel/macros/vba_debug2013.php
                                            https://www.techonthenet.com/excel/macros/vba_debug2016.php

                                            #19109 Score: 0 | Risposta

                                            warp
                                            Partecipante

                                              gibra ha scritto:

                                              Imparare a fare il DEBUG è ancora più importante perché ti aiuta ad analizzare il codice, capire gli errori e come risolverli.

                                              Eccoti alcuni link, ma se fai una ricerca DEBUG VBA EXCEL trovi un sacco di materiale:

                                              https://www.excel-easy.com/vba/examples/debugging.html https://www.techonthenet.com/excel/macros/vba_debug2013.php
                                              https://www.techonthenet.com/excel/macros/vba_debug2016.php

                                              in queste sere andrò a controllare i link ed iniziare ad imparare

                                              Grazie tantissimo dei consigli, sei stato di grande aiuto. 

                                              #19117 Score: 0 | Risposta

                                              warp
                                              Partecipante

                                                provvedo a chiudere il post, alla fine la soluzione al titolo è stata trovata...

                                                devo solo studiare un po di codice e risolvere il secondo quesito .. un giorno ci riuscirò .. 

                                                grazie di tutto. 

                                                #19127 Score: 0 | Risposta

                                                warp
                                                Partecipante

                                                  Gibra, momentaneamente sto tamponando così il problema ... dovrei capire bene come fare il ciclo per non ripetere il codice (in questo caso 3 volte) ma nella realtà sarà per 15 volte... 

                                                  Sub RiportaDatiCliente()
                                                      Dim wbData As Workbook
                                                      Dim wsData As Worksheet
                                                      Dim rCel As Range
                                                      Dim sFolderName As String, sBookName As String
                                                      Dim lColonnaRicerca As Long, lLastRow As Long
                                                      Dim bOpened As Boolean
                                                      Dim vRow As Variant, vCode As Variant
                                                      Dim i As Long
                                                  
                                                      '--- parametri ricerca da modifcare
                                                      sFolderName = ThisWorkbook.Path & "\controllo\"
                                                      '///sBookName = "fogliocassaXYZ.xls"    '//"SUB 123_19.xls"
                                                      lColonnaRicerca = 3   ' corretto (era 2)
                                                      '----------------------------------------------
                                                  
                                                      Application.ScreenUpdating = False
                                                      '--- referenzia il file utilizzato per la ricerca, può essere aperto o chiuso
                                                      
                                                      
                                                      Rem APRE OGNI FILE NELLA CARTELLA, LEGGE I DATI E LO CHIUDE
                                                      sBookName = Dir$(sFolderName & "*.xls")
                                                      Do While sBookName <> ""
                                                          bOpened = False
                                                  
                                                          ' intercetto l'errore se il file non è già aperto, lo apro per leggerlo
                                                          On Error Resume Next
                                                          Set wbData = Workbooks(sBookName)
                                                          If wbData Is Nothing Then
                                                              Set wbData = Workbooks.Open(sFolderName & sBookName, , True)
                                                              bOpened = True
                                                              Err.Clear
                                                          End If
                                                          On Error GoTo 0
                                                          'On Error GoTo Uffa
                                                          ' ora il file è aperto, procedo alla lettura dei dati
                                                      
                                                          '--- modifica il nome del foglio nel quale effettuare la ricerca
                                                          
                                                  
                                                  Set wsData = wbData.Worksheets("Foglio1")
                                                  
                                                        
                                                          
                                                          
                                                          '--- modifica il nome del foglio che contiene i codici da ricercare
                                                          With ThisWorkbook.Worksheets("Foglio1")
                                                              '--- i codici si trovano in colonna B
                                                              lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row
                                                              For i = 1 To lLastRow
                                                                  vCode = .Cells(i, 2)
                                                                  'If vCode = 23797 Then Stop
                                                                  If Len(vCode) Then
                                                                      vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0)
                                                                      If Not IsError(vRow) Then
                                                                          '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay
                                                                          .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value
                                                                      Else
                                                                          '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found")
                                                                      End If
                                                                  End If
                                                              Next i
                                                          End With
                                                          
                                                           '--- modifica il nome del foglio che contiene i codici da ricercare
                                                          With ThisWorkbook.Worksheets("Foglio2")
                                                              '--- i codici si trovano in colonna B
                                                              lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row
                                                              For i = 1 To lLastRow
                                                                  vCode = .Cells(i, 2)
                                                                  'If vCode = 23797 Then Stop
                                                                  If Len(vCode) Then
                                                                      vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0)
                                                                      If Not IsError(vRow) Then
                                                                          '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay
                                                                          .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value
                                                                      Else
                                                                          '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found")
                                                                      End If
                                                                  End If
                                                              Next i
                                                          End With
                                                          
                                                           '--- modifica il nome del foglio che contiene i codici da ricercare
                                                          With ThisWorkbook.Worksheets("Foglio3")
                                                              '--- i codici si trovano in colonna B
                                                              lLastRow = .Cells(Rows.Count, "b").End(xlUp).Row
                                                              For i = 1 To lLastRow
                                                                  vCode = .Cells(i, 2)
                                                                  'If vCode = 23797 Then Stop
                                                                  If Len(vCode) Then
                                                                      vRow = Application.Match(vCode, wsData.Columns(lColonnaRicerca), 0)
                                                                      If Not IsError(vRow) Then
                                                                          '--- copia 4 celle a partire dalla colonna J e le incolla a partire dalla colonna ay
                                                                          .Cells(i, "a").Resize(, 4).Value = wsData.Cells(vRow, "b").Resize(, 4).Value
                                                                      Else
                                                                          '.Cells(rCel.Row, "a").Resize(, 4).Value = Array("not found", "not found", "not found", "not found")
                                                                      End If
                                                                  End If
                                                              Next i
                                                          End With
                                                          
                                                          
                                                          
                                                          wbData.Close False  ' chiudo il file
                                                          Set wbData = Nothing
                                                          sBookName = Dir$()  ' leggo il prossimo
                                                      Loop
                                                      
                                                  ExitHere:
                                                      Application.ScreenUpdating = True
                                                      On Error Resume Next
                                                      If bOpened Then wbData.Close False
                                                  
                                                      Set rCel = Nothing: Set wsData = Nothing: Set wbData = Nothing
                                                      Exit Sub
                                                  
                                                  Uffa:
                                                      Call MsgBox("Ohibò, si è verificato il seguente errore: " & vbNewLine & _
                                                                  CStr(Err.Number) & ": " & Err.Description & vbNewLine & vbNewLine & _
                                                                  "Codice in elaborazione: " & vCode, _
                                                                  vbCritical + vbOKOnly, "Error message")
                                                      Resume ExitHere
                                                  End Sub
                                                  
                                                  Allegati:
                                                  You must be logged in to view attached files.
                                                  #19135 Score: 0 | Risposta

                                                  DeletedUser
                                                  Bloccato
                                                    13 pts

                                                    No, stai sbagliando tutto e ti stai complicando la vita inutilmente.  

                                                    Cosa ti ho scritto nel mio post?
                                                    https://www.excelvba.it/forumexcel/forums/discussione/macro-cerca-valore-in-un-file-e-copia-4-celle-adiacenti/#post-18998

                                                    Rileggi con attenzione.  

                                                    Il codice che ti ho indicato significa che, DOPO aver aperto il file (WBDATA) per ogni foglio che contiene esegui la modifica.

                                                    Invece tu non solo hai mantenuto l'ìistruzione

                                                    Set wsData = wbData.Worksheets("Foglio1")

                                                    ma addirittura hai replicato tutto il codice 3 volte (cioè per ogni foglio):

                                                    Set wsData = wbData.Worksheets("Foglio1")
                                                    
                                                            '--- modifica il nome del foglio che contiene i codici da ricercare
                                                            With ThisWorkbook.Worksheets("Foglio1")
                                                    
                                                            '--- 
                                                            With ThisWorkbook.Worksheets("Foglio2")
                                                    
                                                            '--- 
                                                            With ThisWorkbook.Worksheets("Foglio3")

                                                     

                                                    #19138 Score: 0 | Risposta

                                                    warp
                                                    Partecipante

                                                      warp ha scritto:

                                                      --- modifica il nome del foglio nel quale effettuare la ricerca

                                                      Set wsData = wbData.Worksheets("Foglio1")

                                                      gibra, spe .. riassettiamo un attimo quello che è il mio obiettivo e cosa definisce il codice... 
                                                      il codice sopra citato "Set wsData = wbData.Worksheets("Foglio1") .. si riferisce al file dei foglicassa giusto? e non al filemaster.xls .. dico bene??

                                                       

                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 32 totali)
                                                    Rispondi a: MACRO CERCA VALORE IN UN FILE E COPIA 4 celle adiacenti
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni: