Devi utilizzare la funzione "Consolida" che trovi nel menu "Dati".
Per l'uso consulta l'help di Excel.
--
"Fai sapere se e come hai risolto. Grazie"
Ciao paoloard
trovando nella stessa situazione ho assemblato un po di codice trovato
in giro.. vedi se può esserti di aiuto
tutti i tuoi file nella stessa cartella
Option Explicit
'########Variabili Globali
Option Compare Text
Dim wbOr As Workbook
Dim shOr As Worksheet
Dim WB As Workbook
Dim sh As Worksheet
Sub CercaFile()
Dim XL_arrivati As String
Set wbOr = ActiveWorkbook
Set shOr = wbOr.Sheets("data") 'nome foglio su cui importare
'----------
Dim CalcMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'----------------------
XL_arrivati = "d:\Operation" 'cartella con i file
ListFilesInFolder XL_arrivati, False 'True per le sottocartelle
'----------
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
wbOr.Sheets("data").Columns("A:AZ").EntireColumn.AutoFit
Set wbOr = Nothing
Set shOr = Nothing
End Sub
Private Sub ListFilesInFolder(SourceFolderName As String,
IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'necessite d'aviter la reference Microsoft Scripting RunTime
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder
Dim SubFolder As Scripting.folder
Dim FileItem As Scripting.file
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)
For Each FileItem In SourceFolder.Files
If Right(FileItem.Name, 4) = ".xls" And FileItem.Name <>
ActiveWorkbook.Name Then
'-----------
If IsWbOpen(FileItem.Name) Then
Set WB = Workbooks(FileItem.Name) 'Make the workbook
the Active Workbook
WB.Activate
Else: Set WB = Workbooks.Open(SourceFolderName & "\" &
FileItem.Name)
End If
Route_di_modifica
End If
'-------------
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
'############ Chiusura
Set Fso = Nothing
Set SourceFolder = Nothing
Set WB = Nothing
End Sub
Private Sub Route_di_modifica()
Dim r As Long, c As Long, Last As Long
Dim iRow As Long
Dim HowM As Long
Dim rngIn As Range
Dim rngOut As Range
r = LastRow(shOr)
With WB
Set sh = WB.Sheets(1) 'prende i dati dal foglio1 di tutti i file
With sh
If sh.UsedRange.Count > 1 Then
Last = LastRow(shOr)
sh.UsedRange.Copy Destination:=shOr.Cells(Last + 1, 1)
End If
End With
.Close False
End With
End Sub
Function IsWbOpen(wbName As String) As Boolean
Dim i As Long
For i = Workbooks.Count To 1 Step -1
If Workbooks(i).Name = wbName Then Exit For
Next
If i <> 0 Then IsWbOpen = True
End Function
Private Function LastRow(sh As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = sh.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
--
am. A.
dal blog del " Vero Programmatore"
Il Vero Programmatore ha l'unico computer che funziona senza corrente.
è alimentato dalla sua bioenergia.
> -------------
> ciao... se puoi darmi qualche indicazione in + te ne sarei grato...
> ho creato una nuova cartella "cartella" in cui ho messo i file di excel
> sono da File 1 a File9..
> il codice dove devo inserirlo ??? in un foglio nuovo oppure in uno di
> essi...??
> sai sono poco pratico ...
puoi fare una nuovo file (oppure inserirlo in personal.xls ..vedi
tu!)che salverai nella stesssa cartella degli altri
Alt-F11 per aprire l'Editor di VBA
Menu/Inserisci/Modulo
Incolla il codice...poi
strumenti/riferimenti
cerca Microsoft Scripting RunTime e fleggalo
Alt-F11 per tornare in Excel
avendo cura che un tuo foglio si chiami "data"
altrimenti cambia nel codice
Set shOr = wbOr.Sheets("data")
e cambia ( o cancella se non ti interessa )
wbOr.Sheets("data").Columns("A:AZ").EntireColumn.AutoFit
con
wbOr.shOr.Columns("A:AZ").EntireColumn.AutoFit
...
mi sono accorto che Route_di_modifica è piena di variabili che non ti
servono (le avevo usate per test)
questa va meglio
Private Sub Route_di_modifica()
Dim Last As Long
With WB
Set sh = WB.Sheets(1)
With sh
If sh.UsedRange.Count > 1 Then
Last = LastRow(shOr)
sh.UsedRange.Copy Destination:=shOr.Cells(Last + 1, 1)
End If
End With
.Close False
End With
End Sub
lancia
--
am. A.
dal blog del " Vero Programmatore"
Il Vero Programmatore é una macchina con inserita all'interno una
coscienza umana. E' il comandante delle truppe ARM di Total
Annihilation.