Post by Final JobPost by draleoPost by draleoPost by draleoIn una cartella C:/prova ho diversi file xlsm. In tutti questi c'è il Foglio2 (sempre con la stessa struttura), con i dati che vanno dalla colonna A alla col W.
Possono esserci anche colonne o righe vuote. Non ci sono intestazioni.
Vorrei unirli tutti (accodarli) in un unico foglio di un nuovo workbook (per es "Tutti"), partendo da A1 in giù. Avevo anche trovato su questo Forum una procedura di oltre 10 anni fa- non mi ricordo l'autore-, ma non mi funziona più.
Qualche procedura per l'occorrenza ?
grazie anticipatamente
draleo
PS: se si potesse fare senza aprirli, sarebbe meglio (in quanto la loro apertura è lenta). Altrimenti...va bene ugualmente
ho risolto. ho trovato una vecchia procedura di Bruno Campanini ,che, aggiungendo i riferimenti giusti, ora funziona bene
draleo
Ciao
Puoi postare i riferimenti di questa soluzione?
Grazie
Ale
Perdonate il ritardo , ma i tempi sono quelli che sono. Questa è la soluzione di Bruno.I Fogli da riepilogare soni i Foglio2 di ciascun file
draleo
----------------------------------------------------------------
Public Sub Riepilogo()'By Bruno Campanini
Dim FSO As New FileSystemObject, MyFolder As Folder, i As File
Dim FromWorkbook As Excel.Workbook, j As Range, k As Long
Dim SourceStartCell As String, NumCol As Long, n As Long
Dim TargetRange As Range, SourceRange As Range
'--- Definizioni ---------------------------------------------------
SourceStartCell = "A1"
NumCol = 23
Set MyFolder = FSO.GetFolder("C:\Users\Leonardo\Desktop\Album Esteri\USA\")
Set TargetRange = [Foglio1!A1]
'----------------------------------------------------------------------
Range(TargetRange.End(xlDown), TargetRange(, NumCol)).ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each i In MyFolder.Files
k = 0
Set FromWorkbook = Application.Workbooks.Open(i)
Set SourceRange = FromWorkbook.Worksheets("Foglio2").Range(SourceStartCell)
If IsEmpty(SourceRange) Then
GoTo Continua
Else
Set SourceRange = Range(SourceRange, SourceRange.End(xlDown))
If Not IsEmpty(TargetRange) Then
If IsEmpty(TargetRange(2)) Then
Set TargetRange = TargetRange(2)
Else
Set TargetRange = TargetRange.End(xlDown)(2)
End If
End If
For Each j In SourceRange
k = k + 1
For n = 1 To NumCol
TargetRange(k, n) = SourceRange(k, n)
Next
Next
End If
Continua:
FromWorkbook.Close
Set FromWorkbook = Nothing
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub