Sviluppare funzionalita su Microsoft Office con VBA Macro per importare dati dati da due file separati

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

    lexmanero
    Partecipante

      Buonasera a tutto il forum e complimenti veramente a tutti voi, sono Antonio ed ogni tanto mi cimento con le innumerevoli difficoltà di avere dei file ad hoc per le esigenze. La mia richiesta d'aiuto è destinata ad avere la possibilità di poter importare su un file chiamato Dati, tutti i dati contenuti in altri due file separati, in questo esempio il file Dati importerà i dati dei file separati Pippo e Pippa. I dati dovranno essere accodati agli esistenti partendo dalla prima riga libera, dovrà essere importata anche la formattazione ed eventuali formule contenute. Ad ogni avvio di importazione il file chiamato Dati verificherà se i dati già presenti hanno subito variazioni e quindi importarli. Spero di essere stato chiaro per darvi la possibilità di comprendere come dovrebbe funzionare l'importazione. Ringrazio tutti in anticipo per la disponibilità nei miei confronti.

      Allegati:
      You must be logged in to view attached files.
      #16110 Risposta

      vecchio frac
      Senior Moderator
      • Sfida #1
        157 pts

        Ciao, benvenuto, grazie per i complimenti, ma qual è il problema specifico e puntuale che hai incontrato durante i tuoi tentativi di raggiungere il tuo obiettivo? Ci mostri o descrivi questi tentativi? Che grado di confidenza hai con VBA?

        lexmanero ha scritto:

        Spero di essere stato chiaro per darvi la possibilità di comprendere come dovrebbe funzionare l'importazione

        Certo, chiarissimo e in effetti non è neanche una cosa impossibile, ma siamo qui per aiutare gli utenti a fare da soli, non per sostituirci ad essi.

        #16112 Risposta

        lexmanero
        Partecipante

          Ciao piacere vecchio frac, ti ringrazio per avermi risposto. Purtroppo mi sono rivolto a voi perché di Vba non ne so nulla. Per questo chiedevo questo tipo di aiuto se fosse possibile creare una macro per me. Se non fosse possibile , nessun problema capisco che non potete realizzare macro per tutti. O almeno datemi qualche dritta da dove partire per scrivere il codice. Grazie 

          #16116 Risposta
          patel
          patel
          Moderatore
          • Sfida #6
            31 pts

            Per cominciare potresti usare il registratore di macro, lo attivi, apri il primo file, selezioni il range da copiare, copia, incolla nel file  dati ecc, alla fine chiudi il registratore. Troverai una macro funzionante, ma da migliorare, allega il file con la macro e la modifichiamo.

            #16127 Risposta

            lexmanero
            Partecipante

              Ciao Patel, piacere sono Antonio, ti ringrazio per il suggerimento. Ho effettuato alcune prove che mi hai suggerito che ti invio per una tua analisi e suggerimento per uscirne da questo incubo   .

              Questa è la macro che mi è venuta con il registratore:

              Sub Macro1()
              
                  Windows("Pippo.xlsx").Activate               'questo file dovrei farlo aprire da macro (percorso C:\Users\Antonio\Desktop\Prova)
                  Range("A2:E21").Select                       'copio i dati dal file Pippo e copio i dati dal foglio DatiPippo fino all'ultimo dato disponibile tranne le successive righe vuote
                  Selection.Copy
                  Windows("Dati.xlsm").Activate                'C:\Users\Antonio\Desktop\Prova
                  Range("A2").Select                           'cella in cui inizierà ad incollare i dati appena copiati
                  ActiveSheet.Paste
                  Windows("Pippa.xlsx").Activate               'questo file dovrei farlo aprire da macro (percorso C:\Users\Antonio\Desktop\Prova)
                  Range("A2:E14").Select                       'copio i dati dal file Pippa e copio i dati dal foglio DatiPippa fino all'ultimo dato disponibile tranne le successive righe vuote
                  Application.CutCopyMode = False              '??
                  Selection.Copy
                  Windows("Dati.xlsm").Activate                'C:\Users\Antonio\Desktop\Prova
                  Range("A22").Select                          'prima cella vuota dopo aver incollato i file di Pippo, cella in cui inizierà ad incollare i dati appena copiati
                  ActiveSheet.Paste
                  'In pratica dovrei sempre incollare con lo stesso ordine prima Pippo e poi Pippa
                  'Copiare da Pippo dalla riga 2 fino all'ultima riga con dati, prima di una riga vuota
                  'Incollare i dati di Pippo su Dati partendo dalla cella A2
                  'Invece i dati di Pippa si devono accodare subito dopo l'ultimo dato di Pippo
                  'Tutti i file si trovano su un percorso di rete in questo caso ho messo C:\Users\Antonio\Desktop\Prova
                  'I fogli hanno un nome Dati= DatiUnificati Pippo= DatiPippo Pippa= DatiPippa
                  'Se esiste una funzione che non incolla dati identici già presenti
              End Sub
              
              Invece quest'altra è una macro che farebbe al caso mio ma necessita di qualche modifica esempio accodare i dati di Pippa dopo aver importato i dati di Pippo e copiare in automatico dalla prima riga 2 fino all'ultima riga disponibile con dati:
              
              Option Explicit
              
              Sub Riepilogo()
              
                  Dim FD As FileDialog, MyRange As Range, File As Variant, sh As Byte, LC As Integer, _
                  W1 As Workbook, W2 As Workbook, n As Byte
                  Set MyRange = [a1:ad34]
                  Set W1 = ActiveWorkbook
                  n = 1
                  Set FD = Application.FileDialog(msoFileDialogFilePicker)
              
                  With FD
                      .AllowMultiSelect = True                 'posso selezionare più files
                      .Show
              
                      Application.ScreenUpdating = False       'Conviene spegnere lo schermo
              
                      For Each File In .SelectedItems          'Il ciclo esterno scorre tutti i files selezionati
                          Workbooks.Open File
                          Set W2 = ActiveWorkbook
                          For sh = 1 To Worksheets.Count       'Il ciclo interno scorre tutti i fogli di ogni singolo file
                              ' In ogni foglio prende l'intervallo A1:AD34 e lo incolla nel corrispondente foglio del file di riepilogo
                              W2.Worksheets(sh).Range(MyRange.Address).Copy
                              W1.Worksheets(sh).Cells(1, n).PasteSpecial xlPasteAll
                          Next
                          ' Adesso trovo la colonna su cui posizione il successivo intervallo di dati
                          n = n + Columns("AD").Column         'Rappresenta la colonna AD dell'intervallo preso in esame
                          Application.CutCopyMode = False      'svuoto la memoria dagli appunti
                          W2.Close savechanges:=False
                      Next
                  End With
              
                  Application.ScreenUpdating = True
              
              End Sub
              

              Edit by vecchio frac: ho inserito il codice nell'apposito riquadro dedicato al codice, con le opportune indentazioni. Per inserire codice ricordo che esiste il pulsantino dedicato nell'editor: {;}

              Allegati:
              You must be logged in to view attached files.
              #16131 Risposta
              patel
              patel
              Moderatore
              • Sfida #6
                31 pts

                prendendo spunto dalla seconda macro più completa una soluzione da migiorare potrebbe essere questa

                Sub Riepilogo()
                    Set AW = ActiveWorkbook
                    File1 = "F:\Download\Pippo.xlsx"
                    File2 = "F:\Download\Pippa.xlsx"
                    Workbooks.Open File1
                    Set W1 = ActiveWorkbook
                    lastrow = ActiveSheet.UsedRange.Rows.Count + 1
                    ActiveSheet.UsedRange.Copy
                    AW.Worksheets(1).Cells(1, 1).PasteSpecial xlPasteAll
                    Application.CutCopyMode = False      'svuoto la memoria dagli appunti
                    W1.Close savechanges:=False
                    Workbooks.Open File2
                    Set W2 = ActiveWorkbook
                    ActiveSheet.UsedRange.Offset(1, 0).Copy ' tralascia la prima riga
                    AW.Worksheets(1).Cells(lastrow, 1).PasteSpecial xlPasteAll
                    Application.CutCopyMode = False      'svuoto la memoria dagli appunti
                    W2.Close savechanges:=False
                    AW.Worksheets(1).Cells(1, 1).Select
                End Sub
                #16134 Risposta

                lexmanero
                Partecipante

                  Ragazzi, ottimo   vi ringrazio e vi stimo. Con queste modifiche effettuate sulla seconda macro da parte di patel gira come desideravo. Queste informazioni mi hanno fatto capire qualcosa su Vba, penso che continuerò ad approfondire il mondo Vba.

                  #16164 Risposta

                  lexmanero
                  Partecipante

                    Buonasera ragazzi, scusate se sono ancora quì. Dai test sugli esempi sembrava tutto girare alla perfezione ma sul file originale ce qualche intoppo che non sono riuscito a risolvere. Il primo foglio lo carica bene, mentre il secondo lo porta a partire da  riga 26434 comprese intestazioni. Potete darmi qualche suggerimento?

                    Public Sub Riepilogo()
                        Set AW = ActiveWorkbook
                        File1 = "C:\Users\Antonio\Desktop\Pippo-1.xlsm"
                        File2 = "C:\Users\Antonio\Desktop\Pippa-1.xlsm"
                        Workbooks.Open File1
                        Set W1 = ActiveWorkbook
                        lastrow = ActiveSheet.UsedRange.Rows.Count + 1
                        ActiveSheet.UsedRange.Copy
                        AW.Worksheets(1).Cells(1, 1).PasteSpecial xlPasteAll
                        Application.CutCopyMode = False      'svuoto la memoria dagli appunti
                        W1.Close savechanges:=False
                        Workbooks.Open File2
                        Set W2 = ActiveWorkbook
                        ActiveSheet.UsedRange.Offset(1, 0).Copy ' tralascia la prima riga
                        AW.Worksheets(1).Cells(lastrow, 1).PasteSpecial xlPasteAll
                        Application.CutCopyMode = False      'svuoto la memoria dagli appunti
                        W2.Close savechanges:=False
                        AW.Worksheets(1).Cells(1, 1).Select
                    End Sub
                    Allegati:
                    You must be logged in to view attached files.
                    #16171 Risposta
                    patel
                    patel
                    Moderatore
                    • Sfida #6
                      31 pts

                      in pippo1 le righe che sembrano vuote non lo sono, lo puoi verificare inserendoci questa macro

                      `Sub a()
                      ActiveSheet.UsedRange.Select
                      End Sub`

                      eliminale fino alla riga 26434 e riprova la macro Riepilogo()

                      #16180 Risposta

                      lexmanero
                      Partecipante

                        Ok, ci provo questa sera, non vorrei che le celle invece vengono incollate prelevandolo dal file1 e file2

                        #16217 Risposta

                        lexmanero
                        Partecipante

                          Ottimo...  questa volta funziona.

                          Grazie

                          'prima ho inserito la tua macro per identificare le celle formattate
                          ' ed ho individuato il range complessivo
                          Sub EvidenziaFormattate()
                          ActiveSheet.UsedRange.Select 
                          End Sub
                          
                          'di seguito ho inserito quest altra per selezionare solo le vuote ma formattate ed ho eliminato le formattazioni solo dal range
                          
                          Sub SelezionaRange()
                          ActiveSheet.Range("A8:BW65536").Select
                          End Sub
                          
                        LoginRegistrati
                        Stai vedendo 11 articoli - dal 1 a 11 (di 11 totali)
                        Rispondi a: Macro per importare dati dati da due file separati
                        Gli allegati sono permessi solo ad utenti REGISTRATI
                        Le tue informazioni:



                        vecchio frac - 2388 risposte

                        albatros54
                        albatros54 - 670 risposte

                        patel
                        patel - 541 risposte

                        Marius44
                        Marius44 - 448 risposte

                        Luca73
                        Luca73 - 432 risposte