Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

come unire + file di excel insieme ??

7,687 views
Skip to first unread message

JOE

unread,
Apr 22, 2008, 6:57:30 AM4/22/08
to
salve a tutti.. mi trovo nella necessità di unire più file di excel
che hanno la struttura uguale.. in quanto consegnati a varie persone per
inserire
i dati ed ora bisogna fare un file unico...
vi è qualche maniera per accodare i dati considerando che li chiamerei
File1, file2, file3 etc. ??
inoltre devo partire dal file originale, vuoto, oppure da uno dei già
parzialmente
pieni ??
Ciao

paoloard

unread,
Apr 22, 2008, 10:01:11 AM4/22/08
to

"JOE" <to...@invalid.it> ha scritto nel messaggio
news:uwjPj.63432$FR.2...@twister1.libero.it...

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

am A.

unread,
Apr 22, 2008, 5:29:55 PM4/22/08
to
Nel suo scritto precedente, JOE ha sostenuto :

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.


JOE

unread,
Apr 23, 2008, 3:54:26 AM4/23/08
to
"am A." <a5.al...@TOGLIgmail.com> ha scritto nel messaggio
news:mn.b5817d842...@TOGLIgmail.com...
-------------
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 ...
Ciao


am A.

unread,
Apr 23, 2008, 11:05:00 AM4/23/08
to
JOE ci ha detto :

> "am A." <a5.al...@TOGLIgmail.com> ha scritto nel messaggio
> news:mn.b5817d842...@TOGLIgmail.com...
>> Nel suo scritto precedente, JOE ha sostenuto :
>>> salve a tutti.. mi trovo nella necessità di unire più file di excel
>>> che hanno la struttura uguale.. in quanto consegnati a varie persone per
>>> inserire i dati ed ora bisogna fare un file unico...
>>> vi è qualche maniera per accodare i dati considerando che li chiamerei
>>> File1, file2, file3 etc. ??
>>> inoltre devo partire dal file originale, vuoto, oppure da uno dei già
>>> parzialmente pieni ??
>>
>> 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

> -------------


> 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.


JOE

unread,
Apr 24, 2008, 3:50:01 AM4/24/08
to
"am A." <a5.al...@TOGLIgmail.com> ha scritto nel messaggio >>>
> ...
> 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
--------------
ti ringrazio... mi metto al lavoro...
Ciao


0 new messages