unire piu file in uno solo | Excel e gli applicativi Office

unire più file in uno solo

Hai un problema con Excel?

Nuova discussione

unire più file in uno solo
di mb data: 27/04/2017 14:41:04
buongiorno a tutti

sto cercando di mettere insieme due procedure che sicuramente arrivano dalla stessa fonte ma non riesco a sistemarle

"unire più file in automatico" andrebbe bene per la prima parte dove preleva da un archivio e dopo aver copiato i dati li salva in altra cartella ma ha il problema che copia per colonne i dati

il secondo sarebbe più preciso perché copia i dati dalle celle che io desidero utilizzare però copia solo un file e poi manca lo spostamento nella cartella storico

di mb data: 27/04/2017 14:44:46
questo è il file che ho modificato ed era proposto su questo sito anni fa

lo riproposto così com'era con qualche modifica...

Sub Sfoglia_Files()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT SCRIPTING RUNTIME '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim strPath As String
   
    Dim objFSY As FileSystemObject
    Dim objFOL As Folder
    Dim objFIL As File
    
    Dim wbFrom As Workbook, wbTo As Workbook
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim x As Long, i As Long
    Dim rngCopy As Range
    
    Set wbTo = ThisWorkbook
    Set wsTo = wbTo.Sheets(1)
     
    strPath = "C:Moduli_ricevuti" '''QUI IL PERCORSO DOVE HAI I MILLEMILA FILES
    
    Set objFSY = New FileSystemObject
    Set objFOL = objFSY.GetFolder(strPath)

    For Each objFIL In objFOL.Files
      x = wsTo.Range("B" & wsTo.Rows.Count).End(xlUp).Row + 1
      
      Set wbFrom = Application.Workbooks.Open(objFIL)
      Set wsFrom = wbFrom.Sheets(1) ''QUI IL NUMERO DEL FOGLIO DATASHEET, HO SUPPOSTO SIA IL PRIMO
        With wsFrom
'      cella P2 su colonna C del file Master
          .Range("g8").Copy wsTo.Range("C" & x)
'      cella Q4 su colonna B del file Master
          .Range("d9").Copy wsTo.Range("d" & x)
'      i dati letti su colonna R su colonna BF del file Master ( ci sono dati uguali, copiare solo una volta)
'      NON E' CHIARO
'      cella I8 su colonna D del file Master
          .Range("e17").Copy wsTo.Range("e" & x)
'      cella I10 su colonna E del file Master
          .Range("k17").Copy wsTo.Range("f" & x)
'      cella I12 su colonna F del file Master
          .Range("e19").Copy wsTo.Range("g" & x)
'      cella I14 su colonna G del file Master
'      cella I16 su colonna H del file Master
'      cella I18 su colonna I del file Master
'      cella I20 su colonna J del file Master
'      cella I23 su colonna K del file Master
'      cella I24 su colonna L del file Master
'      cella I25 su colonna M del file Master
'      cella I26 su colonna N del file Master
'      cella I27 su colonna O del file Master
'      cella I28 su colonna P del file Master
'      cella I29 su colonna Q del file Master
'      cella I30 su colonna R del file Master
'      cella I32 su colonna S del file Master
'      cella I33 su colonna T del file Master
'      cella I34 su colonna U del file Master
'      cella I35 su colonna V del file Master
'      cella I36 su colonna W del file Master
'      cella I37 su colonna X del file Master
'      cella I38 su colonna Y del file Master
'      cella I39 su colonna Z del file Master
'      cella I40 su colonna AA del file Master
'      cella I41 su colonna AB del file Master
'      cella I42 su colonna AC del file Master
'      cella I44 su colonna AD del file Master
'      cella I46 su colonna AE del file Master
'      cella J49 su colonna AE del file Master, cella N49 su colonna AG del file Master
'      cella J50 su colonna AH del file Master, cella N50 su colonna AI del file Master
'      cella J51 su colonna AJ del file Master, cella N51 su colonna AK del file Master
'      cella J52 su colonna AL del file Master, cella N52 su colonna AM del file Master
'      cella I53 su colonna AN del file Master
'      cella I55 su colonna AO del file Master
'      cella I56 su colonna AP del file Master
'      cella J57 su colonna AQ del file Master, cella N57 su colonna AR del file Master
'      cella J58 su colonna AS del file Master, cella N58 su colonna AT del file Master
'      cella J59 su colonna AU del file Master, cella N59 su colonna AV del file Master
'      cella I62 su colonna AW del file Master
'      cella I63 su colonna AX del file Master
'      cella I64 su colonna AY del file Master
'      cella I67 su colonna AZ del file Master
'      cella I68 su colonna BA del file Master
'      cella I69 su colonna BB del file Master
'      cella I70 su colonna BC del file Master
'      cella I71 su colonna BD del file Master
'      cella I73 su colonna BE del file Master

        End With
      wbFrom.Close 0
      Set wbFrom = Nothing
      Set wsFrom = Nothing
    Next

    Set objFSY = Nothing
    Set objFOL = Nothing
    Set wbTo = ThisWorkbook
    Set wsTo = Nothing
End Sub

di mb data: 27/04/2017 14:47:52
questo invece è l'altro pezzo di procedura che vorrei aggiungere per salvare i file elaborati ed inserire nome e data di elaborazione dell'archivio...

Se non ricordo male la fonte delle due procedure è sempre la stessa ....

grazie

   MiaDir = "C:Moduli_Ricevuti" ' ----->> ADATTA i nomi
    Perc_Stor = "Storico" ' ----->> ADATTA i nomi
    File_El = Dir(MiaDir & "*.xls")
    If File_El = "" Then
        MsgBox "ATTENZIONE: nel percorso   '" & MiaDir & "'   non sono stati trovati file"
        Exit Sub
    End If
    
    I = Workbooks(Nome_Iniziale).Sheets(WS_Out).Range("A" & Rows.Count).End(xlUp).Row + 1
    Righe = I
    File_Cop = 0
    While File_El <> ""
        Nome_Attuale = File_El
        Workbooks.Open Filename:=MiaDir & Nome_Attuale
        WS_In = Workbooks(Nome_Attuale).ActiveSheet.Name
        RR = Workbooks(Nome_Attuale).Sheets(WS_In).Range("A" & Rows.Count).End(xlUp).Row
        For J = 2 To RR
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 1) = File_El
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 2) = Date

di patel data: 27/04/2017 15:32:45
invece di proporre soluzioni allega i file di esempio da unire e quello col risultato desiderato
di mb data: 27/04/2017 15:45:22
scusa patel ma i tre file sono nella cartella rar non si apre ??

negli esempi allegato ho messo due file pippo e pluto

nel file con la macro mi riporta solo il primo file

Fammi sapere

Grazie
di mb data: 27/04/2017 15:52:54
nel file allegato mb2

Vi ho inserito il risultato sperato

grazie per la disponibilità
di patel data: 27/04/2017 16:13:52
pippo e pluto mi sembrano uguali, comunque insisto, non proponete soluzioni come spiegazione, spiegate bene cosa c'è da fare, se poi avete fatto qualche prova allegatela, ma non deve essere quella la spiegazione
di mb data: 27/04/2017 17:36:22
mi spiace ma le prove che ho fatto sono i file che ho allegato

il file mb2 serve solo per far vedere cosa mi piacerebbe ottenere dalla copia dei due file in quello riepilogativo dove ho almeno 20 celle uguali in tutti i file da copiare nel file di riepilogo

nel primo file come vedi è solo riportato il nome del primo fornitore siccome ne ho 130 vorrei poterli ricopiare tutti senza dover fare tutto a mano

da incompetente penso ci voglia un ciclo che apre i file copia i dati impostati, chiude il file e passa all'elaborazione successiva..

scusa.. se non riesco
di mb data: 28/04/2017 10:16:02
Buongiorno

Ci sono riuscito ....

finisco solo un lavoro urgente e poi posto il file

se qualcuno comunque riesce a darmi un suggerimento lo accetto volentieri perchè ormai ho capito che con VBA ci sono diverse strade per arrivare allo stesso risultato un pò come com google map o waze

a fra poco
di mb data: 28/04/2017 10:56:01
Eccomi ho allegato una serie di file che ho zippato

con questo sistema creando una cartella incassi in C salvo i due file e poi posso elaborare il file come desideravo

in realtà dovrei fare un'aggiunta : al termine di tutte le operazioni salvare in una cartella old i file originali dai quali ho prelevato i dati ...

se qualcuno più esperto ritiene ci sia una soluzione migliore come ho detto prima è ben gradita

buona giornata

file MB3
di mb data: 28/04/2017 14:40:13
Buon pomeriggio

chiedo ancora il Vostro prezioso aiuto per chiudere l'argomento

l'intenzione era a fine elaborazione di spostare i file dai quali ho preso i dati dentro la cartella old

pensavo con move di ottenere questo risultato invece il file rimane sempre nella stessa cartella ma vien semplicemente rinominato con oldpippo oppure oldpluto

Grazie
' spostare i file Dim dest As String dest = strPath & "" & "old" For Each ofil In oFOL.Files ofil.Move dest & ofil.Name Next ofil

di mb data: 28/04/2017 15:13:46
c'era un errore di "sintassi"

' spostare i file


Dim dest As String

dest = strPath & "" & "old"

For Each ofil In oFOL.Files

'ofil.Move dest & ofil.Name

ofil.Move dest & "" & ofil.Name
Next

di mb data: 28/04/2017 15:14:39
grazie

alla prossima

Vuoi Approfondire?