› Sviluppare funzionalita su Microsoft Office con VBA › Macro per importare dati dati da due file separati
-
AutoreArticoli
-
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.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?
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.
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
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.
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.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
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.
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.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()
Ok, ci provo questa sera, non vorrei che le celle invece vengono incollate prelevandolo dal file1 e file2
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
-
AutoreArticoli