copiare celle prefissate da + fogli lavoroxcel

[gianpaoloimparato]

Buonasera a tutti. Sono nuovo del forum e spero mi possiate dare una indicazione:
Ho un cliente (che mi fa uscire pazzo) che mi invia ogni giorno ordini x mail utilizzando un singolo file xcel x ogni ordine.
Mi ritrovo dunque ad aprire ogni volta fino a 50 file e dover processare e stampare i dati di ogni singolo foglio.
Il mio sogno sarebbe di riassumere in un nuovo foglio i dati utili dei vari ordini (6 celle in tutto che si trovano sempre nelle stesse posizioni su tutti i fogli) su singole righe di un unico file.
In tal modo potrei quindi processarli automaticamente
Avete qualche idea?

Grazie in anticipo

Gianpaolo

[ricky53]

Ciao,
prima di tutto benvenuto nel nostro forum.

Per poterti proporre una soluzione puoi scriverci quali sono le celle da copiare.

I file vengono salvati tutti nella stessa cartella ?
I nomi dei vari file hanno una parte in comune? (Es. file_001.xls, file_002.xls, file_003.xls, ...)

Che conoscenza del VBA e della programmazione hai?

[gianpaoloimparato]

Ciao Ricky
grazie del benvenuto

1. Le celle che vorrei copiare su di un unica riga sono: B17;B18;B3;B5;B2 uguali x tutti i file.
2. I file vengono salvati manualmente in una singola cartella vuota.
3. I nomi dei file sono: 1000-9072.xls, 1000-9078.xls, 21000-3517.xls, 556-1090.xls ecc.: la prima cifra è il negozio da cui proviene l'ordine della catena, il secondo è il numero progressivo dell'ordine. Questo è un esempio di file che ricevo:

Transaction 12523
Order 9072
Customer Van Lier, Roger

Store 51SUHO Hoofddorp
0252681660
A4@cuttothebone.nl
Please put ordernumber and shopcode on invoice to Sharmoon

Delivery address Sharmooon EZ Garments Co. LTD
Industrial district Airport street
325013 Wenzhou, Republic of China
Contact person Chen Chi (13676468713) and/or Alex Wang (15057561506)

Order created on 28-4-2011
Ordered on 28-4-2011
Fabric A592/11
Required fabric (meters) 3,13


quello che vorrei ottenere è una riga contenente:
A592/11;3.13;Van Lier Roger;51SUHO;9072

4. purtroppo non ho alcuna nozione né di VBA né di programmazione, ma tanta buona volontà.
Spero che tu mi possa in qualche modo dare una soluzione.
Grazie
Gianpaolo

[ricky53]

Ciao,
bravo. Spiegazione chiara e precisa.
Si la cosa è fattbile.
Non avendo tu conoscenze di VBA e di programmazione cercherò di proporti un esempio che tu possa facilmente utilizzare.

Una conferma: nel Percorso (o Cartella) del PC esistono solo i file che tu vuoi unire in un solo file "XLS" ?

[ricky53]

Ciao,
prova questo esempio:

Codice: Seleziona tutto

Option Explicit

Sub Leggi_Dati_e_Copia_Celle()
    Dim Percorso As String, Estensione As String, MioFile As String, I As Integer, RR As Integer, Messaggio As String
    Dim mFile As Excel.Application, mWBook_In As Excel.Workbook, mWBook_Out As Excel.Workbook, mWs_In As Excel.Worksheet, mWs_Out As Excel.Worksheet, vValue As Variant
   
    Application.ScreenUpdating = False
    Percorso = "D:\Temp\Excel\" ' <<---- SCRIVI IL NOME DEL TUO PERCORSO

    Set mFile = New Excel.Application
    Set mWBook_Out = ActiveWorkbook
    Set mWs_Out = mWBook_Out.Worksheets(1) ' <<---- "1" rappresenta il primo foglio del file sul quale scrivere i dati dei vari fogli
    RR = mWs_Out.Range("A" & Rows.Count).End(xlUp).Row
    If RR = 1 Then
        RR = 2
    End If
    mWs_Out.Range("A2:E" & RR).ClearContents ' <<---- cancella i dati presenti nel file sul quale scrivere i dati dei vari fogli
   
    Estensione = "XLS"
    MioFile = Dir(Percorso & "*." & Estensione)
    On Error GoTo Continua
    Set mWBook_In = mFile.Workbooks.Open(Percorso & MioFile)
    Set mWs_In = mWBook_In.Worksheets(1) ' <<---- "1" rappresenta il primo foglio del file che viene elaborato
   
    I = 1
    Do While MioFile <> ""
        I = I + 1
        mWs_Out.Cells(I, 1) = mWs_In.Range("B17")
        mWs_Out.Cells(I, 2) = mWs_In.Range("B18")
        mWs_Out.Cells(I, 3) = mWs_In.Range("B3")
        mWs_Out.Cells(I, 4) = mWs_In.Range("B5")
        mWs_Out.Cells(I, 5) = mWs_In.Range("B2")
        mWBook_In.Close SaveChanges:=False
       
        MioFile = Dir()
       
        Set mWBook_In = mFile.Workbooks.Open(Percorso & MioFile)
        Set mWs_In = mWBook_In.Worksheets(1) ' <<---- "1" rappresenta il primo foglio del file che viene elaborato
    Loop
   
Continua:
    Application.ScreenUpdating = True
    If I = 0 Then
        Messaggio = "Nel percorso:   ''" & Percorso & "''" & vbCrLf & vbCrLf & "Non sono stati trovati file aventi estensione   ''" & Estensione & "''"
    Else
        Messaggio = "Effettuata elaborazione di:   ''" & I & "''   File"
    End If
    MsgBox Messaggio
   
    Set mWBook_In = Nothing
    Set mWBook_Out = Nothing
    Set mWs_In = Nothing
    Set mWs_Out = Nothing
    Set mFile = Nothing
End Sub


Ecco come operare:
0. apri un nuovo file XLS
1. apri l'editor del VB con "Alt+F11"
2. Tasto destro, inserisci un "Modulo"
3. copia, nel modulo, il codice che ti ho inviato
4. torna sul foglio EXCEL
5. "Alt+F8", seleziona la macro "Leggi_Dati_e_Copia_Celle" (Volendo puoi associare ad una combinazione di Tasti la macro, tasto"Opzioni" ...)
6. "Esegui"

[gianpaoloimparato]

Ciao Ricky,
scusa il ritardo... sono stato fuori x lavoro
Il risultato della tua soluzione è perfetto
Tutto funziona come dovuto : è proprio quello che volevo ottenere in un click
Grazie mille e complimenti

Gianpaolo

[ricky53]

Ciao,
mi fa piacere esserti stato utile.

Grazie a te per il riscontro ed i complimenti.

Buon proseguimento e ... alla prossima.