Questo browser non è più supportato.
Esegui l'aggiornamento a Microsoft Edge per sfruttare i vantaggi di funzionalità più recenti, aggiornamenti della sicurezza e supporto tecnico.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Buongiorno a tutti,
avrei la necessità di riepilogare una serie di dati contenuti in file excel formattati tutti uguali.
questi file excel non sono nominati tutti uguali e sono contenuti in sottocartelle in una cartella.
io dovrei riassumere in questo file tutte le stesse celle provenienti dai vari file ed inserire il percorso linkabile(se possibile ) :
| nome (A1) | cognome (B20) | via (H45) | indirizzo ( ecc..) | dati | note | percorso |
|---|---|---|---|---|---|---|
| pippo | rossi | via rossi | //c:./.. | |||
| gino | bianchi | via bianchi | //c../ |
Qualcuno mi può indicare come fare? e dove inserire la query e salvarla?
Grazie.
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.
Ciao Seghezzi,
Posterò ulteriori istruzioni per quanto riguarda l'implementazione del codice. Comunque, avendo letto la tua risposta, approfitterò per anche modificare la parte del codice che riguarda l'operazione di copia. Mi occuperò di questo dopo la cena.
===
Regards,
Norman
Ciao Norman,
ho fatto tutto ciò che mi hai detto.
cliccando su esegui la query gira senza errori sul file Riassuntivo. ma rimane vuoto!
ovviamente vedendole tue istruzioni ho due domandine:
Const sFileRiassuntivo As String = "prova.xlsm" '<<==== Modificato ??????????estensione secondo indicazioni di salvataggio giusto?
Const sFoglioRiassuntivo As String = "Riepilogo" '<<==== Modifica
Const sNomeFoglio As String = "Sheet1" '<<==== Modifica
Const CelleDaCopiare As String = "B2;B6;B8" ?????queste sono le celle da copiare nei vari files???? o sono le celle di destinazione?
ma cosa dovrei fare altro sul file devo impostare qualcosa?
grazie.
Ciao Seghezzi,
'=========>>
Option Explicit
'--------->>
Public Sub Tester()
Dim srcWB As Workbook, destWB As Workbook
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim destSH As Worksheet, srcSH As Worksheet
Dim srcRng As Range, destRng As Range
Dim LRow As Long
Dim iCtr As Long
Dim CalcMode As Long
Const sPercorso As String = _
"C:\Utenti\Seghezzi\Italia" '<<==== Modifica
Const sCartella As String = "Ordini" '<<==== Modifica
Const sFileRiassuntivo As String = "Riassuntivo.xlsx" '<<==== Modifica
Const sFoglioRiassuntivo As String = "Riepilogo" '<<==== Modifica
Const sNomeFoglio As String = "Sheet1" '<<==== Modifica
Const CelleDaCopiare As String = "A4:K4" '<<==== Modifica
Set destWB = Workbooks.Open(sPercorso & sFileRiassuntivo)
Set destSH = destWB.Sheets(sFoglioRiassuntivo)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPercorso & sCartella)
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each oSubFolder In oFolder.Subfolders
For Each oFile In oSubFolder.Files
Set srcWB = Workbooks.Open(oFile.Path)
With srcWB
Set srcSH = .Sheets(sNomeFoglio)
Set srcRng = srcSH.Range(CelleDaCopiare)
With destSH
LRow = LastRow(destSH, .Columns("A:A"))
Set destRng = .Range("A" & LRow + 1).Resize(1, srcRng.Columns.Count)
End With
srcRng.Copy Destination:=destRng
With destRng
destSH.Hyperlinks.Add Anchor:=.Cells(1, .Columns.Count + 1), _
Address:=oFile.Path, _
TextToDisplay:=srcWB.Name
End With
End With
iCtr = iCtr + 1
srcWB.Close SaveChanges:=False
Next oFile
Next oSubFolder
destWB.Close SaveChanges:=True
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
MsgBox Prompt:=iCtr & " file sono stati riepologati", _
Buttons:=vbInformation, _
Title:="REPORT"
End Sub
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range, _
Optional minRow As Long = 1)
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
If LastRow < minRow Then
LastRow = minRow
End If
End Function
'<<=========
Se non hai familiarità con le macro, ti consiglio il seguente articolo eccellente di Mauro:
===
Regards,
Norman
Buongiorno Norman,
la struttura è la seguente, i in una cartella esempio : Italia è contenuto il file riassuntivo e una cartella es. Ordini , all'interno della cartella ordini ci sono innumerevoli cartelle con il nome dei venditori, e all'interno di queste cartelle sono contenuti i file excel
I file excel sono tutti uguali e viene utilizzato solo il foglio 1 nominato "Sheet1"
la struttura della tabella riassuntiva sarà questa e si dovrà compilare per ogni file nella directory.
| RENTAL <br><br>SERVICE <br><br>PPTEST | TENDER RIF | PAYER | TOWN | SHIP TO | TOWN | INSTR. MODEL | START DATE | END DATE | STATUS | NOTE | FILES VIEW |
|---|---|---|---|---|---|---|---|---|---|---|---|
| $B$28 | $B$29 | $B$8 | $B$10 | $B$2 | $B$6 | $B$19 | $B$34 | $B$35 | SE(I2>(ADESSO());"ACTIVE";"EXPIRED") | $B$36 | gianni rossi new.xlsx |
Spero di essere stato chiaro.
Ciao Seghezzi,
avrei la necessità di riepilogare una serie di dati contenuti in file excel formattati tutti uguali.
questi file excel non sono nominati tutti uguali e sono contenuti in sottocartelle in una cartella.
io dovrei riassumere in questo file tutte le stesse celle provenienti dai vari file ed inserire il percorso linkabile(se possibile ) :
nome (A1) cognome (B20) via (H45) indirizzo ( ecc..) dati note percorso pippo rossi via rossi //c:./.. gino bianchi via bianchi //c../ Qualcuno mi può indicare come fare? e dove inserire la query e salvarla?
===
Regards,
Norman