Condividi:        

copiare files in cartella in unico file di riepilogo

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

copiare files in cartella in unico file di riepilogo

Postdi BG66 » 12/04/19 12:38

Buongiorno a tutti,
vorrei copiare il foglio 1 del singolo file presente in cartella raggruppandoli in un solo file "RIEPILOGO.xlsm".

Ho provato ad adattare una macro di un vecchio thread:
Codice: Seleziona tutto
Public perc As String, Ws1 As String, f As String, WB1 As String
Sub ARCHIVIO()
Application.ScreenUpdating = False
Application.Calculation = xlManual
perc = ThisWorkbook.Path
If Dir(perc & "\ArchivioXls", vbDirectory) = "" Then
    MkDir (perc & "\ArchivioXls")
End If
WB1 = ThisWorkbook.Name
Ws1 = "Foglio1"
Worksheets(Ws1).Select
Range("A1").Select
  ElencoFile Direct:=perc, Estens:="*.xlsx*", Inicell:=ActiveCell
    Columns("A:AZ").EntireColumn.AutoFit
    Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub ElencoFile(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, f As String
  ChDir Direct
  f = Dir(Estens)
  If f = "" Then Exit Sub
  While f <> ""
    If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        URF = Workbooks(f).Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
        URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
        Workbooks(f).ActiveSheet.Rows("1:" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
        Workbooks(f).Close savechanges:=False
        FileCopy perc & "\" & f, perc & "\ArchivioXls\" & f
            Kill perc & "\" & f
    End If
    f = Dir
  Wend
End Sub

ma il debug non gradisce:
Immagine

Ho provato a girarci intorno rinunciando all'archiviazione:
Codice: Seleziona tutto
Sub Unisci()
Dim MyPath As String
Dim MyName As String
Dim iRow As Long
Dim iCount As Long
Dim wksOrig As Workbook
Dim shOrig As Worksheet
Dim wksDest As Workbook
Dim shDest As Worksheet
Dim xRow As Long
Dim iCol As Integer


Application.ScreenUpdating = False
Set wksDest = ThisWorkbook
Set shDest = wksDest.Sheets("RIEPILOGO")


MyPath = ThisWorkbook.Path & "\*.xls"    ' Imposta il percorso.
MyName = Dir(MyPath, vbNormal)   ' Recupera la prima voce.
Do While MyName <> ""    ' Avvia il ciclo.
   
    If MyName <> wksDest.Name Then 'esclude se stesso
   
        Set wksOrig = Workbooks.Open(MyName)
        Set shOrig = wksOrig.Sheets(1) '<=== da verificare


        With shDest


            iRow = .Range("a" & Rows.Count).End(xlUp).Row + 1 'determina la prima riga vuota del foglio Destinazione
            iCount = shOrig.Range("a" & Rows.Count).End(xlUp).Row ' determina l'ultima riga piena del foglio Origine
   
            For xRow = 2 To iCount 'avvia il ciclo righe
                For iCol = 1 To 10 ' avvia ciclo colonne
                    .Cells(iRow, iCol) = shOrig.Cells(xRow, iCol) 'scrive valori
                Next
                iRow = iRow + 1
            Next
            wksOrig.Close 'chiude il foglio Origine
        End With
    End If

    MyName = Dir    ' Legge la voce successiva.
Loop

Application.ScreenUpdating = True

Set wksDest = Nothing
Set shDest = Nothing
Set wksOrig = Nothing
Set shOrig = Nothing

End Sub

ma il debug protesta:

Immagine

Cosa ovviamente sbaglio!!??!!

Esempio di file origine (xls) presenti in cartella: https://www.dropbox.com/s/cy93k9d73md1c4k/8%2C3%20forum.xls?dl=0
File RIEPILOGO.xlsm: https://www.dropbox.com/s/91uxt6fx6mjgsxd/Riepilogo.xlsm?dl=0


Grazie per l'aiuto
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: copiare files in cartella in unico file di riepilogo

Postdi klingklang » 12/04/19 12:50

Cosa ovviamente sbaglio!!??!!


Hai installato Swiss Knife e non lo usi?!? Ecco cosa sbagli!! :lol: :lol: :lol:
(perdonami la battuta :D )
Enrico
Windows 7 + Office 2016 64bit / Windows 10 + Office 365 32/64bit
Avatar utente
klingklang
Utente Junior
 
Post: 97
Iscritto il: 23/11/18 15:01
Località: San Giovanni in Persiceto

Re: copiare files in cartella in unico file di riepilogo

Postdi zsadist » 12/04/19 13:01

ciao
come prima cosa, ad occhio, il primo errore:

WB1 = ThisWorkbook.Name
Ws1 = "Foglio1" <------ ERRATO... ti darà errore
Worksheets(Ws1).Select
Range("A1").Select


scrivi
WB1 = ThisWorkbook.Name
Ws1 = "RIEPILOGO"
Sheets(Ws1).Select
Range("A1").Select


poi....

Codice: Seleziona tutto
Sub ARCHIVIO()
Application.ScreenUpdating = False
Application.Calculation = xlManual
perc = ThisWorkbook.Path
If Dir(perc & "\ArchivioXls", vbDirectory) = "" Then
    MkDir (perc & "\ArchivioXls")
End If
WB1 = ThisWorkbook.Name
Ws1 = "RIEPILOGO"
Sheets(Ws1).Select
Range("A1").Select
  ElencoFile Direct:=perc, Estens:="*.xlsx*", Inicell:=ActiveCell 'elenca i file nella stessa directory del file Riepilogo?
                                                                ' allora prima perchè hai creato una cartella??
    Columns("A:AZ").EntireColumn.AutoFit
    Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


fammi capire, crei la directory ArchivioXls e poi richiami l'elenco dei file xlsx nella stessa directory del file Riepilogo.xlsm? a che pro?
:roll:

come dico a tutti, io faccio difficoltà a capire, quindi, vediamo se ho capito bene:
tu vuoi raggruppare in un unico File (Riepilogo.xlsm) i fogli dei file contenuti nella cartella ArchivioXls?

ma i dati o l'intero foglio?
e devono essere copiati su fogli diversi del file Riepilogo.xlsm o in un unico foglio?
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 12/04/19 13:36

@ klingklang
la tua mitica utility può aiutarmi anche in questo caso ???

@zsadist

fammi capire, crei la directory ArchivioXls e poi richiami l'elenco dei file xlsx nella stessa directory del file Riepilogo.xlsm? a che pro?

In realtà la directory archivio mi dovrebbe evitare di continuare a importare gli stessi file

tu vuoi raggruppare in un unico File (Riepilogo.xlsm) i fogli dei file contenuti nella cartella ArchivioXls?

Quasi. Vorrei raggruppare il foglio 1 di tutti i files presenti in cartella master prima di archiviarli in ArchivioXls.
Ma questo è un di più mi basterebbe solo raggruppare in un unico file, tutti i "foglio1" presenti in cartella master.

ma i dati o l'intero foglio?

Intero foglio.

e devono essere copiati su fogli diversi del file Riepilogo.xlsm o in un unico foglio?

Ognuno in un foglio singolo.

Grazie per l'aiuto.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi zsadist » 12/04/19 14:01

Ok, a vista d'occhio, tra un e l'altro codice, sistemandoli, si potrebbe fare, se proprio non vuoi un exnovo

però ora non posso.. anzi.. prima di lunedì non potrò..

quindi.. se non ricevi aiuto prima di lunedì, poi cercherò di farti una bozza funzionale...

mi spiace non poterti aiutare ora

buon week end
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: copiare files in cartella in unico file di riepilogo

Postdi klingklang » 12/04/19 14:17

BG66 ha scritto:@ klingklang
la tua mitica utility può aiutarmi anche in questo caso ???

Azz... ci sono MORTO su questo tool! :lol: :lol: :lol:
L'unica difficoltà che vedo è se il primo foglio di ciascun file ha un nome sempre diverso e senza nulla in comune con gli altri: infatti il filtro può essere fatto sul nome dei fogli da importare, non sul loro indice. Beh, prova e fammi sapere magari ;)
Enrico
Windows 7 + Office 2016 64bit / Windows 10 + Office 365 32/64bit
Avatar utente
klingklang
Utente Junior
 
Post: 97
Iscritto il: 23/11/18 15:01
Località: San Giovanni in Persiceto

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 12/04/19 14:53

@ klingklang
il foglio 1 si chiama sempre Scatole in tutti i files e i dati sono sempre nelle stesse colonne / celle ( come da file allegato).
ESK può aiutarmi e come?


@zsadist
Ti ringrazio della tua disponibilità, ovviamente, provo a proseguire da solo nel WE, nel caso che questo thread non sia risolto per lunedi, il tuo intervento sarà graditissimo ed apprezzato ;)
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi klingklang » 12/04/19 14:59

BG66 ha scritto:@ klingklang
il foglio 1 si chiama sempre Scatole in tutti i files e i dati sono sempre nelle stesse colonne / celle ( come da file allegato).
ESK può aiutarmi e come?


Segui il link che ti ho messo nel messaggio precedente: il tool è nella sezione "Importa/Esporta" e per attivare il filtro sui fogli devi prima cliccare il pulsante "Avanzate". Per il resto le opzioni mi sembrano auto-esplicative, ma se hai ancora qualche dubbio puoi dettagliarlo qui
Enrico
Windows 7 + Office 2016 64bit / Windows 10 + Office 365 32/64bit
Avatar utente
klingklang
Utente Junior
 
Post: 97
Iscritto il: 23/11/18 15:01
Località: San Giovanni in Persiceto

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 12/04/19 21:43

@ klingklang
E' super... ma siccome l'appetito vien mangiando.. :lol:
ESK può aiutarmi ad eliminare l'intera riga quando la cella corrispondente nella colonna E è vuota ?
https://www.dropbox.com/s/9w0ipm5lco7j1rq/RIEPILOGO_ESK.xlsm?dl=0

Attendo tue.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi Anthony47 » 13/04/19 02:11

Vedo che stai andando avanti col tool di KK, bene.

Io ho provato creando 3 copie del file 8,3 forum.xls; poi ho eseguito la macro contenuta nel file Riepilogo.xlsm, che si e' completata senza problemi (anche se non so se i risultati ottenuti erano quelli giusti).

Quale era il messaggio di errore che tu ottenevi?

Se, mentre sei in debug, apri la Finestra Variabili Locati, alla variabile MyName quale valore risulta assegnato? Se provi ad aprire quel file tramite il comando File /Apri, esso si apre regolarmente? Non e' per caso gia' aperto per altri motivi?

Guardando il contenuto del foglio Riepilogo, puoi stimare se prima dell'errore sono stati processati dei file, e quanti sul totale?

Portandomi avanti, segnalo anche che l'intero ciclo For xRow = 2 to iCount /Next [xRow] potra' essere sostituito con l'istruzione
Codice: Seleziona tutto
            .Cells(iRow, 1).Resize(iCount, 10).Value = shOrig.Cells(2, 1).Resize(iCount, 10).Value

Se posso permettermi, trovo un po' confusivo assegnare a una variabile di tipo Workbook il nome wksDest; meno male che per un tipo Worksheet non hai usato un nome quale wbDest.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 13/04/19 07:04

Ciao Anthony,
di seguito risposte:
Anthony47 ha scritto:Quale era il messaggio di errore che tu ottenevi?
Se, mentre sei in debug, apri la Finestra Variabili Locati, alla variabile MyName quale valore risulta assegnato?

Stesso errore segnalato nel primo post.
Immagine

Se provi ad aprire quel file tramite il comando File /Apri, esso si apre regolarmente? Non e' per caso gia' aperto per altri motivi?

Si apre regolarmente senza avviso di file già aperto.
Guardando il contenuto del foglio Riepilogo, puoi stimare se prima dell'errore sono stati processati dei file, e quanti sul totale?

Zero processati.

Se posso permettermi, trovo un po' confusivo assegnare a una variabile di tipo Workbook il nome wksDest; meno male che per un tipo Worksheet non hai usato un nome quale wbDest.

Sostituito wksDest con WbDest idem anche per wksOrig.

Grazie per l'aiuto , attendo tue.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi Anthony47 » 13/04/19 10:57

Stesso errore segnalato nel primo post.
:evil:
Se ti chiedo quale e' il messaggio di errore e' perche' "nel primo post" non l'ho trovato. Non escludo di essere orbo, quindi chiedo un aiutino...

Comunque, in attesa che tu mi dica quale e' il messaggio di errore o dove devo guardare per vederlo:
-ma il file pubblicato e' attendibile? Perche' l'istruzione iCount = shOrig.Range("a" & Rows.Count) etc etc restituira' sempre 1 (la struttura dati presente nel foglio1 lascia libera colonna A), quindi quando anche arriviassimo alla copia dei dati su Riepilogo non si copierebbe nulla.

-prova a modificare le istruzioni in questa parte di codice:
Codice: Seleziona tutto
'ISTRUZIONI SOSTITUITE:
'MyPath = ThisWorkbook.Path & "\*.xls"    ' Imposta il percorso.
'MyName = Dir(MyPath, vbNormal)   ' Recupera la prima voce.
'Do While MyName <> ""    ' Avvia il ciclo.
'
'    If MyName <> wksDest.Name Then 'esclude se stesso
'
'        Set wksOrig = Workbooks.Open(MyName)
'
'ISTRUZIONI SOSTITUTIVE:
MyPath = ThisWorkbook.Path & "\"    ' Imposta il percorso.
MyName = Dir(MyPath & "*.xls", vbNormal)   ' Recupera la prima voce.
Do While MyName <> ""    ' Avvia il ciclo.
    If MyName <> wksDest.Name Then 'esclude se stesso
        Set wksOrig = Workbooks.Open(MyPath & MyName)
'...continua...

Come vedi ho gestito in modo diverso MyPath e MyName

Tieni anche presente che l'uso di "*.xls" ti restituira' solo file xls; se pensi di dover leggere anche .xlsx/m allora modifica in "*.xls*"

Ti suggerisco anche di modificare il calcolo di iCount:
Codice: Seleziona tutto
iCount = shOrig.Range("a" & shOrig.Rows.Count).End(xlUp).Row


e di chiudere il file tramite
Codice: Seleziona tutto
wksOrig.Close False                  'Chiude senza salvare


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: copiare files in cartella in unico file di riepilogo

Postdi klingklang » 13/04/19 14:15

BG66 ha scritto:@ klingklang
E' super... ma siccome l'appetito vien mangiando.. :lol:
ESK può aiutarmi ad eliminare l'intera riga quando la cella corrispondente nella colonna E è vuota ?
https://www.dropbox.com/s/9w0ipm5lco7j1rq/RIEPILOGO_ESK.xlsm?dl=0

Attendo tue.


Aggiungerò questa opzione al tool di selezione righe/colonne condizionale nella prossima versione (chissà perché non l'ho fatto prima). Comunque un filtro automatico sulla colonna, celle vuote, seleziona tutto ed elimina... funziona bene lo stesso ;)
Sono lieto che ti sia stato di aiuto. Sapessi quante tonnellate di lavoro risparmia a me! :D (Probabilmente molto meno di quello che ho impiegato a realizzarlo! :lol: :lol: )
Enrico
Windows 7 + Office 2016 64bit / Windows 10 + Office 365 32/64bit
Avatar utente
klingklang
Utente Junior
 
Post: 97
Iscritto il: 23/11/18 15:01
Località: San Giovanni in Persiceto

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 13/04/19 20:11

Anthony47 ha scritto:
Stesso errore segnalato nel primo post.
:evil:
Se ti chiedo quale e' il messaggio di errore e' perche' "nel primo post" non l'ho trovato. Non escludo di essere orbo, quindi chiedo un aiutino...


Ciao Anthony,
scusami tanto...errore mio...avevo stupidamente deciso che ti riferissi alla riga evidenziata nello script.. :oops:
L'errore è questo:
Immagine

Intanto inizio ad applicare le modifiche che mi hai suggerito.

Grazie e scusami ancora (non mi piace sembrare arrogante o presuntuoso)
Gene

@ klingklang
E' un piacere sapere che un pezzettino di ESK sarà implementato da un mio suggerimento.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi Anthony47 » 15/04/19 13:37

Grazie e scusami ancora (non mi piace sembrare arrogante o presuntuoso)
Ti perdono di tutto :D

Comunque il messaggio rinforza l'idea che mi aveva portato a modificare quella parte di codice.

Ciao!
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 17/04/19 16:20

Ciao Anthony,
integrato script ma sbaglio qualcosa compreso tentativi vari, errore ottenuto:
Immagine

Immagine


https://www.dropbox.com/s/w2f2pe384d72v4s/RIEPILOGO_Anthony.xlsm?dl=0

Grazie ancora e Buona Pasqua.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi Anthony47 » 17/04/19 17:01

Ma... sbaglio o tu avevi modificato il nome della variabile wksDest in wbDest??
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: copiare files in cartella in unico file di riepilogo

Postdi zsadist » 17/04/19 17:52

eh si si, mi sa proprio che si è scordato di cambiare in quella stringa il nome assegnato:

si legge infatti

  • Set wbDest = ThisWorkBook
  • Set shDest = wbDest.Sheets("Riepilogo")

ma poi ha scritto

If MyName <> wksDest.Name Then ' commento

Codice: Seleziona tutto
Set wbDest = ThisWorkBook
Set shDest = wbDest.Sheets("Riepilogo")

'ma poi ha scritto

If MyName <> wksDest.Name Then ' commento



ti consiglio di eseguire una ricerca, anzi, un sostituisci in tutta la routine :)
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: copiare files in cartella in unico file di riepilogo

Postdi BG66 » 17/04/19 20:58

[RISOLTO]
Ciao a tutti,
per punizione per avervi fatto stupidamente ammattire mi metto in stand-by ........fino a dopo Pasqua.

Ancora auguri a tutti.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: copiare files in cartella in unico file di riepilogo

Postdi zsadist » 17/04/19 21:06

Buona Pasqua a te :)
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48


Torna a Applicazioni Office Windows


Topic correlati a "copiare files in cartella in unico file di riepilogo":


Chi c’è in linea

Visitano il forum: Nessuno e 58 ospiti