Sviluppare funzionalita su Microsoft Office con VBA Cerca riferimento su altro foglio e copia dati del 1 foglio

LoginRegistrati
Stai vedendo 18 articoli - dal 1 a 18 (di 18 totali)
  • Autore
    Articoli
  • #29771 Risposta

    tacchino82
    Partecipante

      Salve a tutti,
      Sto incontrando qualche difficoltà perché non riesco a copiare alcune celle di un foglio su un' altro foglio..... Mi spiego:

      Vorrei trovare sul foglio 2 nella colonna 5 il rigo con valore uguale al foglio 1 range h1. Dopo di che copiare sul foglio 2 dopo la colonna g i dati presenti nelle celle d4 d8 d9 del foglio 1.

      Praticamente un cerca valore e inserisci in orizzontale dopo la colonna g.

      Grazie

      Allegati:
      You must be logged in to view attached files.
      #29775 Risposta
      rollis13
      rollis13
      Partecipante

        Ti propongo questa mia macro, fa quello che chiedi ma è impostata per fare la copia Foglio/Foglio stesso File. Lascio a te implementare la copia Foglio/Foglio altro File. La macro la puoi mettere anche in un Modulo standard.

        Option Explicit
        
        Sub Cerca_Copia()
        
            Dim ur1    As Long                            'ultima riga cartella1
            Dim uc1    As Long                            'ultima colonna cartella1
            Dim ur2    As Long                            'ultima riga cartella2
            Dim riga   As Long                            'riga in elaborazione
            Dim codice As Range                           'codice in elaborazione
            Dim sh1    As Worksheet                       'foglio cartella1
            Dim sh2    As Worksheet                       'foglio cartella2
        
            Application.ScreenUpdating = False
            Set sh1 = Sheets("cartella1")
            Set sh2 = Sheets("cartella2")
            ur1 = sh1.Range("B" & Rows.Count).End(xlUp).Row
            ur2 = sh2.Range("E" & Rows.Count).End(xlUp).Row
            For riga = 3 To ur2    'inizia dalla 3' riga
                Set codice = sh1.Range("B2:B" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole)
                If Not codice Is Nothing Then
                    uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1
                    If uc1 < 4 Then uc1 = 4    'inizia dalla 4' colonna 
                    sh2.Range("A" & riga & ":C" & riga).Copy sh1.Cells(codice.Row, uc1)
                End If
            Next riga
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
            
        End Sub
        #29785 Risposta

        tacchino82
        Partecipante

          Ciao, ho modificato il tuo codice e lo posto sotto.

          mi va in debug su what.

          come vedi ho anche inserito i valori e ti li ho commentati.

          `Option Explicit
          
          Sub Cerca_Copia()
          
              Dim ur1    As Long                            'ultima riga cartella1
              Dim uc1    As Long                            'ultima colonna cartella1
              Dim ur2    As Long                            'ultima riga cartella2
              Dim riga   As Long                            'riga in elaborazione
              Dim codice As Range                           'codice in elaborazione
              Dim sh1    As Worksheet                       'foglio cartella1
              Dim sh2    As Worksheet                       'foglio cartella2
          
              Application.ScreenUpdating = False
              Set sh1 = workbooks("cartel1.xls")worksheets("foglio1")
              Set sh2 = workbooks("cartel2.xls")worksheets("foglio2")
              ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row       'controlla la colonna c
              ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row      'cerca su colonna AD 
              For riga = 9 To ur2    'inizia dalla 9 riga'
                  Set codice = sh1.Range("C10:C19" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole)    'controlla sulla colonna c da c10 a c19
                  If Not codice Is Nothing Then
                      uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1
                      If uc1 < 196 Then uc1 = 196    'inizia dalla 4' colonna 
                      sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1)  'copia da N a Q
                  End If
              Next riga
              Application.CutCopyMode = False
              Application.ScreenUpdating = True
              
          End Sub`
          #29786 Risposta

          tacchino82
          Partecipante
            Option Explicit
            
            Sub Cerca_Copia()
            
                Dim ur1    As Long                            'ultima riga cartella1
                Dim uc1    As Long                            'ultima colonna cartella1
                Dim ur2    As Long                            'ultima riga cartella2
                Dim riga   As Long                            'riga in elaborazione
                Dim codice As Range                           'codice in elaborazione
                Dim sh1    As Worksheet                       'foglio cartella1
                Dim sh2    As Worksheet                       'foglio cartella2
            
                Application.ScreenUpdating = False
                Set sh1 = workbooks("cartel1.xls").workSheets("foglio1")
                Set sh2 = workbooks("cartel2.xls").workSheets("foglio2")
                ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row    ' colonna dove controlla dati cartl1
                ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row   ' colonna dove controlla dati cartl2
                For riga = 9 To ur2    'inizia dalla 9' riga
                    Set codice = sh1.Range("C10:C" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole)
                    If Not codice Is Nothing Then
                        uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1
                        If uc1 < 196 Then uc1 = 196    'inizia dalla 196 colonna 
                        sh2.Range("A" & riga & ":C" & riga).Copy sh1.Cells(codice.Row, uc1)
                    End If
                Next riga
                Application.CutCopyMode = False
                Application.ScreenUpdating = True
                
            End Sub

            Ciao Ho modificato il tuo codice.

            mi va in debug su what.

            ho inserito anche i commenti xchè ho modificato la ricerca ed i parametri.

             

            #29789 Risposta
            rollis13
            rollis13
            Partecipante

              Non avendo accesso ad altri dati, io sono fermo all'unico allegato in post #29771 e non ho la sfera di cristallo, ad intuito, se il Debug si ferma su quella riga di codice è molto probabile che non hai adeguato correttamente il riferimento della colonna (5) che, se ho capito bene le tue modifiche, ora è vuota.

              #29879 Risposta

              tacchino82
              Partecipante

                I set sh1 e sh2 sono impostati correttamente?

                #29881 Risposta
                rollis13
                rollis13
                Partecipante

                  Mi ripeto, la mia macro è collaudata sulla struttura del file che hai allegato al primo post ed è perfettamente funzionante. Non credo sia un problema del Forum ma io continuo a non vedere altri allegati oltre al primo.

                  #29889 Risposta

                  tacchino82
                  Partecipante

                    Buongiorno,

                    per prima cosa ti ringrazio per l'interessamento, pubblico i due file con l'impostazione che devono avere.

                    Ho provato ad implementare il codice da te proposto ma non mi funziona.

                    Nella cartella2/foglio2 deve andare a scrivere in corrispondenza del codice trovato nelle celle gialle (prima cella utile GO, se occupata seconda cella utile sul solito rigo HB, se trova occupata terza cella utile HO, se trova occupata quarta cella libera IB) i valori della cartella1/foglio1.

                    Deve fare il controllo fino alla cella c19 sulla cartella1/foglio1.

                    Grazie

                    PS: spero di essere stato un pò più chiaro.

                    Allegati:
                    You must be logged in to view attached files.
                    #29904 Risposta
                    rollis13
                    rollis13
                    Partecipante

                      Hai un layout completamente scombinato rispetto all’primo allegato, hai moltissime colonne nascoste tanto che nell’area GO e seguito del Foglio2 stai cercando di copiare celle consecutive in celle alternate. Nella macro hai scambiato le coordinate di Copia con quelle di Incolla. Per non dire della formattazione personalizzata della colonna C del Foglio1 tale da impedire il confronto con il codice di ricercato.

                      Dato che per ora la ricerca è impostata solo per la prima occorrenza di un codice ho ‘aggiustato’ la parte della macro preposta al Cerca / Copia / Incolla. Per potere visualizzare un risultato dovrai, oltre a scoprire le colonne nell’area GO Foglio2, anche cambiare la formattazione della colonna C Foglio1 in ‘Generale’.

                      ...
                      For riga = 9 To ur2
                          Set codice = sh1.Range("C9:C" & ur1).Find(sh2.Cells(riga, 30), LookIn:=xlValues, lookat:=xlWhole)
                          If Not codice Is Nothing Then
                              uc1 = sh2.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1
                              If uc1 < 197 Then uc1 = 197
                              sh1.Range("N" & codice.Row & ":Q" & codice.Row).Copy sh2.Cells(riga, uc1)
                          End If
                      Next riga
                      ...

                      Fatto questo, se hai intenzione di sistemare il layout del tuo progetto e dopo che hai riallegato le cartelle ‘ripulite’, possiamo parlare anche delle gestione dei codici ripetuti in colonna C altrimenti la mia disponibilità finisce con questo post.

                      #29954 Risposta

                      tacchino82
                      Partecipante

                        ciao Rollis13,

                        ho modificato il tuo codice, capisco la tua richiesta ma il file deve essere come pubblicato proprio perchè a priori ci sono molti  altri dati.

                        Posto il codice tuo modificato e funzionante sulla mia struttura, solo avrei la necessita che mi scrivesse il primo dato (che prende nella colonna N poi saltasse una cella e scrivesse il secondo dato che si trova nella colonna O, così da farlo risultare allineato al mio layout. per lo spostamento in toto basta che modifichi il + 9.....

                        uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 9 'cambio il nove con quello che mi serve

                        Grazie

                        codice completo:

                        Sub CERCACOPIA_ok()
                        
                        Dim ur1 As Long         'ultima riga cartella1
                        Dim uc1 As Long         'ultima colonna cartella1
                        Dim ur2 As Long         'ultima riga cartella2
                        Dim riga As Long        'riga in elaborazione
                        Dim codice As Range     'codice in elaborazione
                        Dim sh1 As Worksheet    'foglio cartella1
                        Dim sh2 As Worksheet    'foglio cartella2
                        
                        Application.ScreenUpdating = False
                        
                        Set sh1 = Workbooks("cartella2.xlsm").Worksheets("cartella2")
                        Set sh2 = Workbooks("cartella1.xls").Worksheets("cartella1")
                        
                        
                        ur1 = sh1.Range("AD" & Rows.Count).End(xlUp).Row
                        ur2 = sh2.Range("C" & Rows.Count).End(xlUp).Row
                        
                        For riga = 10 To ur2
                        
                        Set codice = sh1.Range("AD9:AD" & ur1).Find(what:=sh2.Cells(riga, 3), LookIn:=xlValues, LookAt:=xlWhole)
                        
                        If Not codice Is Nothing Then
                        
                        uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 9
                        If uc1 < 199 Then uc1 = 199
                        sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1)
                        End If
                        
                        Next riga
                        
                        Application.CutCopyMode = False
                        Application.ScreenUpdating = True
                        
                        
                        
                        End Sub

                         

                         

                        #29960 Risposta
                        rollis13
                        rollis13
                        Partecipante

                          Ti basta prendere questa riga:

                          sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1)

                          e duplicarla 4 volte, 1 per ogni diversa colonna invece che una copia in blocco e poi aggiustare la variabile 'uc1' aggiungendo un +2 per le righe successive.

                          #29986 Risposta

                          tacchino82
                          Partecipante

                            Ripubblico i due file stavolta con descrizione di quello che mi servirebbe all'interno.

                             

                            Alessio

                            Allegati:
                            You must be logged in to view attached files.
                            #29989 Risposta
                            rollis13
                            rollis13
                            Partecipante

                              Ecco la macro adeguata con l'apporto delle modifiche che ti avevo suggerito nel mio post precedente.

                              Option Explicit
                              
                              Sub CERCACOPIA_1_2()
                              
                                  Dim ur1    As Long                            'ultima riga cartella1
                                  Dim uc2    As Long                            'ultima colonna cartella2
                                  Dim ur2    As Long                            'ultima riga cartella2
                                  Dim riga   As Long                            'riga in elaborazione
                                  Dim codice As Range                           'codice in elaborazione
                                  Dim sh1    As Worksheet                       'foglio cartella1
                                  Dim sh2    As Worksheet                       'foglio cartella2
                              
                                  Application.ScreenUpdating = False
                                  Set sh2 = Workbooks("cartella2-1.xls").Worksheets("Foglio2")
                                  Set sh1 = Workbooks("cartella1-1.xls").Worksheets("Foglio1")
                                  ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row
                                  ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row
                                  For riga = 10 To ur1
                                      Set codice = sh2.Range("AD9:AD" & ur2).Find(What:=sh1.Cells(riga, 3), LookAt:=xlWhole, LookIn:=xlValues, SearchFormat:=False)
                                      If Not codice Is Nothing Then
                                          uc2 = sh2.Cells(codice.Row, sh2.Cells.Columns.Count).End(xlToLeft).Column
                                          Select Case uc2
                                              Case Is < 197
                                                  uc2 = 197
                                              Case Is < 210
                                                  uc2 = 210
                                              Case Is < 223
                                                  uc2 = 223
                                              Case Is < 236
                                                  uc2 = 236
                                          End Select
                                          sh1.Range("N" & riga).Copy sh2.Cells(codice.Row, uc2)
                                          sh1.Range("O" & riga).Copy sh2.Cells(codice.Row, uc2 + 2)
                                          sh1.Range("P" & riga).Copy sh2.Cells(codice.Row, uc2 + 4)
                                          sh1.Range("Q" & riga).Copy sh2.Cells(codice.Row, uc2 + 6)
                                      End If
                                  Next riga
                                  Application.CutCopyMode = False
                                  Application.ScreenUpdating = True
                                  
                              End Sub
                              #29990 Risposta
                              rollis13
                              rollis13
                              Partecipante
                                #29999 Risposta

                                tacchino82
                                Partecipante

                                  Chiedo scusa non sapevo che non si potesse.

                                  #30000 Risposta
                                  rollis13
                                  rollis13
                                  Partecipante

                                    Basta aver letto il Regolamento di ogni singolo Forum come richiesto al momento della registrazione.

                                    #30015 Risposta

                                    tacchino82
                                    Partecipante

                                      Ti ringrazio rollis e chiedo scusa soprattutto a te.

                                      Ho testato il tuo codice, ma c è qualcosa che non va..... Nel senso che uc2 conta le colonne piene e vuote? Non riesco ad impostare la giusta posizione dove copia i dati, se cambio i parametri di uc2, in alcune occasioni non copia niente anche se su c della cartella 1 (N-O-P-Q) i dati ci sono.

                                      Grazie 

                                      #30018 Risposta
                                      rollis13
                                      rollis13
                                      Partecipante

                                        La macro è testata in tutte le salse ed i valori riportati nel Select Case uc2 sono esatti per gli ultimi file allegati al post #29986; le combinazioni indicate nel Select Case uc2 corrispondono esattamente alle colonne GO, HB, HO, IB della Cartella2.

                                        Se a volte con dati reali non copia tutto probabilmente è per la formattazione personalizzata che hai dato alla colonna C in Cartella1. Evidentemente il parametro SearchFormat:=False del Find non digerisce tutti i valori presenti; ma questo te l'avevo già detto "Per non dire della formattazione personalizzata della colonna C del Foglio1 tale da impedire il confronto con il codice di ricercato." già nel post #29904.

                                      LoginRegistrati
                                      Stai vedendo 18 articoli - dal 1 a 18 (di 18 totali)
                                      Rispondi a: Cerca riferimento su altro foglio e copia dati del 1 foglio
                                      Gli allegati sono permessi solo ad utenti REGISTRATI
                                      Le tue informazioni:



                                      vecchio frac - 2750 risposte

                                      albatros54
                                      albatros54 - 1052 risposte

                                      patel
                                      patel - 1045 risposte

                                      Marius44
                                      Marius44 - 943 risposte

                                      Luca73
                                      Luca73 - 757 risposte