Macro per importare dati dati da due file separati

[lexmaneroPartecipante lexmanero]

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.

[vecchio fracSenior Moderator vecchio frac Karma: 245 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.

[lexmaneroPartecipante lexmanero]

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 

[patelModeratore patel Karma: 50 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.

[lexmaneroPartecipante lexmanero]

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.

[patelModeratore patel Karma: 50 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

[lexmaneroPartecipante lexmanero]

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.

[lexmaneroPartecipante lexmanero]

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.

[patelModeratore patel Karma: 50 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()

[lexmaneroPartecipante lexmanero]

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

[lexmaneroPartecipante lexmanero]

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

[Autore]

Articoli