Riepilogo Database da file excel

Hai un problema con Excel?

Nuova discussione

Riepilogo Database da file excel
di ffante data: 23/04/2016 21:59:06
Buonasera ho la necessità di riepilogare i dati di otto file identici in un foglio di un file riepilogo Database. I dati di origine si trovano sul "foglio6" di ogni file e le colonne interessate sono "A:Y" per ogni file il "foglio6" è nascosto per proteggere i dati.

dal file di riepilogo dovrei creare una macro per ogni singolo file che mi copi dal "foglio6" l'intervallo "A2:Y" fino all'untima riga piena e copiarlo nel file "Riepilogo Database" del foglio "Database" per tutti i file presenti.

ho allegato un file esempio dove c'è la bozza dei file e il file di Riepilogo Database.

franco

di alfrimpa data: 23/04/2016 23:26:49
Ciao Franco

Qualche giorno fa ho scritto per un utente di altro forum la macro che vedi sotto che, concettualmente, è quello che devi fare tu.

Differisce dal tuo proposito solo per il fatto che copia la cella F7 di ogni file e la incolla nel file di riepilogo in colonna A accodando i vari dati.

Certo va cambiata e non poco ma era giusto per dare uno spunto anche perchè ora non ho modo di vedere i tuoi file.

Se hai bisogno sono qua.

Alfredo

Sub CreaDatabase()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim ur As Long
Dim nomefile As String
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:Claudio") '<==== Cambiare con il tuo percorso
For Each objFile In objFolder.Files
    nomefile = objFile.Name
    ur = Cells(Rows.Count, 1).End(xlUp).Row
    Workbooks.Open objFile
    ActiveWorkbook.ActiveSheet.Range("F7").Copy
    Windows("Claudio.xlsm").Activate
    ActiveSheet.Range("a" & ur + 1).Select
    ActiveSheet.Paste
    Workbooks(nomefile).Close
Next objFile
Application.ScreenUpdating = True
End Sub

di ffante data: 24/04/2016 16:20:41
Grazie Alfredo per la tua risposta sempre pronta.
Ho cercato di riadattare la macro alle mie esigenze e nel far girare la macro ho notato che i dati vengono copiati dal file che ho inserito e incolla i dati sullo stesso file, non mi considera il file di riepilogo database.
ho inserito il codice vedi se ci puoi dare un'occhiata grazie

Sub CreaDatabase()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim ur As Long
Dim nomefile As String
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:UsersMichela_2DesktopReportProve") '<==== Cambiare con il tuo percorso
For Each objFile In objFolder.Files
    nomefile = objFile.Name
    Workbooks.Open objFile
    Sheets("Database").Visible = True
    Sheets("Database").Select
    ur = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Range("A2:Y1000").Copy
    Windows("Riepilogo Database.xlsm").Activate
    ActiveSheet.Range("a" & ur + 1).Select
    ActiveSheet.Paste
    Workbooks(nomefile).Close
Next objFile
Application.ScreenUpdating = True
End Sub

di alfrimpa data: 24/04/2016 16:49:53
Ciao Franco

Due cose:

1) La macro la devi inserire nel file "Riepilogo Database.xlsm" e lanciarla da lì
2) Se non l'hai fatto riunisci tutti i file da cui copiare in un'unica directory lasciando al di fuori "Riepilogo Database.xlsm"

Altro non mi verrebbe da dire; prova un po' e ci risentiamo.

Alfredo

P.S. I file che hai allegato sono vuoti (almeno nella zona A1:Yn) sarebbe utile che li popolassi un po' per fare delle prove
di ffante data: 24/04/2016 18:07:51
Ho inserito la macro come mi hai consigliato nel file "Riepilogo Database" e ho riunito tutti i file in un unica cartella,

ho provato a far girare la macro col Tasto F8 e ho potuto verificare che apre i file in sequenza uno ad uno e li copia. legge

i dati dal foglio6 nel range("A2:Y366") di ogni file ed è nascosto. non li incolla sul file "Riepilogo Database"

Se nella richiesta del salvataggio dei dati rispondo si li posso incollare manualmente vorrei automatizzare anche questo passaggio.

come se la riga "ActiveSheet.Paste" non venisse considerata.

di ffante data: 25/04/2016 22:06:04
Risolto grazie Alfredo...

Sub CreaDatabase_AC()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ur As Long
    Dim nomefile As String

    Application.ScreenUpdating = False
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder("C:UsersMichela_2DesktopReportProveAC") '<==== Cambiare con il tuo percorso
    For Each objFile In objFolder.Files
    nomefile = objFile.Name
    Workbooks.Open objFile
    Sheets("Database").Visible = True
    Sheets("Database").Select
    ur = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Range("A2:Y367").Copy
    
    Windows("Riepilogo Database.xlsm").Activate
    ActiveSheet.Range("a" & ur + 1).Select
    
    Workbooks(nomefile).Close
    Next objFile
    
    Application.ScreenUpdating = True

    Sheets("Database").Range("A2").Select
    ActiveSheet.Paste
    MsgBox "FILE REPORT AC COPIATO"

End Sub

di alfrimpa data: 25/04/2016 22:15:57
Mi fa piacere per te ma il problema qual era?

Alfredo

Vuoi Approfondire?