Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 01:33

Ciao,
ho un problema su una formula VBA. Sono riuscito a copiare diverse celle in ordine sparso da svariati file presenti in una cartella e incollarli in un nuovo file in riga ed uno sotto l'altro.. il mio grosso problema è che alcune celle non me le copia anche se il percorso è giusto.. secondo voi è possibile che ciò avvega perche ci sono delle formattazioni delle celle tipo formule e/o delle valute?

per esempio ho un dei campi dove ho scritto NOME DELLA BANCA, RATA, DURATA PRESTITO E MONTANTE (Formula rata x durata) non mi copia nulla di ciò che ho appena descritto e non capisco il perchè.. ovviamente quelli appena descritti sono dati fondamentali.
Visto che questa è la mia prima formula in VBA avrei bisogno di un consiglio su come risolvere il mio problema. ecco la formula che ho creato-scopiazzato sarei disposto ad inviare una copia del file per farvi capire esattamente di che cosa ho bisogno
grazie ;-)


Codice: Seleziona tutto
Sub CARICA_DATI_DIRETTO()
ChDir ("C:\Users\MY CREDIT\Desktop\PROVA MACRO")
  MyF = Dir("*.xls")
  If MyF = "" Then Exit Sub
  While MyF <> ""
    Call Fimp(MyF)
    MyF = Dir
  Wend
End Sub

Sub Fimp(NFile)
Workbooks.Open Filename:=NFile
Sheets("TELEFONATA").Activate
RNum = ThisWorkbook.Sheets("Foglio1").Cells(Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "A") = Range("A1").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "B") = Range("B2").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "C") = Range("B3").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "D") = Range("B4").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "E") = Range("B5").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "F") = Range("B7").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "G") = Range("B8").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "H") = Range("B9").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "I") = Range("B10").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "J") = Range("C10").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "K") = Range("B11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "L") = Range("C11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "M") = Range("B12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "N") = Range("C12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "O") = Range("B13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "P") = Range("B15").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "Q") = Range("B17").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "R") = Range("B19").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "S") = Range("B20").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "T") = Range("C20").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "U") = Range("B21").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "V") = Range("B23").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "W") = Range("B24").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "X") = Range("B25").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "Y") = Range("C25").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "Z") = Range("B27").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AA") = Range("B28").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AB") = Range("B29").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AC") = Range("C30").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AD") = Range("C31").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AE") = Range("C32").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AF") = Range("C33").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AG") = Range("C34").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AH") = Range("B36").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AI") = Range("B37").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AJ") = Range("B38").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AK") = Range("H1").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AL") = Range("H2").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AM") = Range("H3").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AN") = Range("H5").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AO") = Range("H8").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AP") = Range("E12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AQ") = Range("F12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AR") = Range("H12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AS") = Range("I12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AT") = Range("J12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AU") = Range("K12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AV") = Range("N12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AW") = Range("O12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AX") = Range("P12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AY") = Range("Q12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AZ") = Range("R12").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AP") = Range("E13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AQ") = Range("F13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AR") = Range("H13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AS") = Range("I13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AT") = Range("J13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AU") = Range("K13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AV") = Range("N13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AW") = Range("O13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AX") = Range("P13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AY") = Range("Q13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AZ") = Range("R13").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AP") = Range("E14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AQ") = Range("F14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AR") = Range("H14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AS") = Range("I14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AT") = Range("J14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AU") = Range("K14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AV") = Range("N14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AW") = Range("O14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AX") = Range("P14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AY") = Range("Q14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AZ") = Range("R14").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BA") = Range("H23").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BB") = Range("H24").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BC") = Range("H25").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BD") = Range("H26").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BE") = Range("H27").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BF") = Range("H28").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BG") = Range("H29").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BH") = Range("H30").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BI") = Range("H31").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BJ") = Range("H32").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BK") = Range("H33").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BL") = Range("H34").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BM") = Range("H35").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BN") = Range("H36").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BO") = Range("H37").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BP") = Range("H38").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BQ") = Range("H39").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BR") = Range("B6").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BS") = Range("B16").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BT") = Range("B18").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BU") = Range("B26").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BV") = Range("B30").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BW") = Range("B31").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BX") = Range("B32").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BY") = Range("B33").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "BZ") = Range("B35").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CA") = Range("H4").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CB") = Range("H7").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CC") = Range("E11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CD") = Range("F11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CE") = Range("H11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CF") = Range("I11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CG") = Range("J11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CH") = Range("K11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CI") = Range("M11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CJ") = Range("N11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CK") = Range("O11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CL") = Range("P11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CM") = Range("Q11").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CN") = Range("H16").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CO") = Range("H17").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CP") = Range("H18").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CQ") = Range("H19").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CR") = Range("H20").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CS") = Range("H21").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CT") = Range("H22").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CU") = Range("H23").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CV") = Range("H24").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CW") = Range("H25").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CX") = Range("H26").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CY") = Range("H27").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "CZ") = Range("H28").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DA") = Range("H29").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DB") = Range("H30").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DC") = Range("H31").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DD") = Range("H32").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DE") = Range("H33").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DF") = Range("H34").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DG") = Range("H35").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DH") = Range("H36").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DI") = Range("H37").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DJ") = Range("H38").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DK") = Range("H39").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DL") = Range("H40").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DM") = Range("H41").Value '<<<
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DN") = Range("H42").Value '<<<
Workbooks(NFile).Close savechanges:=False
End Sub
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Sponsor
 

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 01:35

ovviamente non posso andare a modificare i 6000 file per eseguire al meglio la formula, ho necessità di aggirare eventuali problemi ma mi rimetto agli esperti ;-)
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 07/12/13 01:46

Se alcune celle "te le copia male" allora questo puo' dipendere dalla formattazione presente nel file di origine non presente nel file di destinazione; es 5 dic 2013 17:00 ti diventera' probabilmente 41613,71. Dovrebbe bastare applicare la formattazione giusta alla colonna del file di destinazione e il tutto dovrebbe riquadrare.
Se invece "non te le copia" allora l' arcano va debuggato lavorando su un caso reale.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 03:26

senti, ma se ti invio un file riesci a dargli un'occhiata?
i miei file sono abbastanza complessi, piu che altro non capisco come mai su alcune schede me li copia ed in altri no, in alcuni casi sono solo delle celle di testo e non me le copia...
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Zer0Kelvin » 07/12/13 06:53

intanto puoi provare a modificare così la Macro, dovrebbe migliorare un pò la velocità di esecuzione:
Codice: Seleziona tutto
Sub Fimp(NFile)
Dim wkNew As Workbook
Dim shOrig As Worksheet, shDest As Worksheet
Dim RNum As Long
    Set wkNew = Workbooks.Open(Filename:=NFile)
    If Not wkNew Is Nothing Then
        Set shOrig = wkNew.Sheets("TELEFONATA")
        Set shDest = ThisWorkbook.Sheets("Foglio1")
        RNum = shDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With shOrig
            shDest.Cells(RNum, "A") = .Range("A1") '<<<
            shDest.Cells(RNum, "B") = .Range("B2") '<<<
            'eccetera
            'eccetera
            'eccetera
            shDest.Cells(RNum, "DN") = .Range("H42") '<<<
        End With
        wkNew.Close savechanges:=False
        Set wkNew = Nothing
        Set shOrig = Nothing
        Set shDest = Nothing
    End If
End Sub


PS: non è che ci sono delle celle unite da qualche parte?
[Win7,Office2010]
Condividere la conoscenza aumenta la ricchezza di tutti(Z0°K)
Dai ad un uomo un pesce e lo avrai sfamato per un giorno;insegnagli a pescare e lo avrai sfamato per sempre(Confucio)
Il sonno della ragione genera mostri(Francisco Goya)
Avatar utente
Zer0Kelvin
Utente Senior
 
Post: 303
Iscritto il: 08/04/12 11:23

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 07/12/13 10:36

Ma hai fatto dei test per determinare se sono sempre certi file che danno problemi, o sempre certi campi?
Per questo potrebbe aiutare inserire questa ulteriore istruzione:
Codice: Seleziona tutto
RNum = ThisWorkbook.Sheets("Foglio1").Cells(Rows.Count, "A").End(xlUp).Row  'Esistente
ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "DO") = Range("H42").Value '<<< AGGIUNGERE QUI
In questo in ultima colonna avrai il nome file, quindi modo potrai verificare quali file restituiscono campi vuoti e potrai indagare meglio, sia esaminando il file incriminato e sia ripetendo piu' volte il processo per verificare se il problema e' ripetitivo o e' casuale.

Per quanto riguarda la pubblicazione di un file di test, questo ha senso solo se "quel file" causa un problema; quindi ha senso dopo che hai approfondito con la modifica suddetta le domande iniziali.

Rimanderei a una "fase 2" l' eventuale miglioramento della macro.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 15:32

Ciao, adesso mi aggiunge i campi di cui ho bisogno ma non mi inserisce il nome del file forse perche non inserisco nel posto giusto l'ultima formula che mi hai segnalato.
premetto dicendo che sono completamente ignorante in VBA e che questa è la mia prima formula.
ti chiedo di verificare sulla base di questa formula semplificata (ho eliminato per ora i campi che funzionavano per testare solo quelli che non mi leggeva altrimenti era tutto troppo lungo).
Riesci a consigliarmi la formula corretta per fare in modo che al posto della prima colonna venga fuori diretamente il nome del file e non alla fine? i nomi dei file sono abbastanza complessi perche codificati in funzione del contenuto della scheda per esempio: ATC NON ASSUMIBILE -AG1- 2_AT_SMALL_RINN_ID 2749 - SXXXXA MASSIMO.xls questo è il nome del file che mi dice che è la scheda di un cliente che non è finanziabile prodotto small business id cartaceo 2749 agenzia 1 provincia di residenza del cliente AT ecc ecc. sarebbe utile inserirlo all'inizio in colonna A e poi tutti i dati delle varie celle che mi servono. ti posto la formula completa che ho modificato sulla base delle tue preziosissime informazioni, RIESCI A CORREGGERMELA? gRAZIE 1000

Codice: Seleziona tutto
Sub CARICA_DATI_DIRETTO()
ChDir ("C:\Users\MY CREDIT\Desktop\PROVA MACRO")
  MyF = Dir("*.xls")
  If MyF = "" Then Exit Sub
  While MyF <> ""
    Call Fimp(MyF)
    MyF = Dir
  Wend
End Sub

Sub Fimp(NFile)
Dim wkNew As Workbook
Dim shOrig As Worksheet, shDest As Worksheet
Dim RNum As Long
    Set wkNew = Workbooks.Open(Filename:=NFile)
    If Not wkNew Is Nothing Then
        Set shOrig = wkNew.Sheets("TELEFONATA")
        Set shDest = ThisWorkbook.Sheets("Foglio1")
        RNum = shDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With shOrig
            shDest.Cells(RNum, "A") = .Range("A1") '<<<
            shDest.Cells(RNum, "B") = .Range("B7") '<<<
            shDest.Cells(RNum, "C") = .Range("B8") '<<<
            shDest.Cells(RNum, "D") = .Range("B9") '<<<
            shDest.Cells(RNum, "E") = .Range("E12") '<<<
            shDest.Cells(RNum, "F") = .Range("F12") '<<<
            shDest.Cells(RNum, "G") = .Range("H12") '<<<
            shDest.Cells(RNum, "H") = .Range("I12") '<<<
            shDest.Cells(RNum, "I") = .Range("J12") '<<<
            shDest.Cells(RNum, "J") = .Range("K12") '<<<
            shDest.Cells(RNum, "K") = .Range("N12") '<<<
            shDest.Cells(RNum, "L") = .Range("O12") '<<<
            shDest.Cells(RNum, "M") = .Range("P12") '<<<
            shDest.Cells(RNum, "N") = .Range("Q12") '<<<
            shDest.Cells(RNum, "O") = .Range("E13") '<<<
            shDest.Cells(RNum, "P") = .Range("F13") '<<<
            shDest.Cells(RNum, "Q") = .Range("H13") '<<<
            shDest.Cells(RNum, "R") = .Range("I13") '<<<
            shDest.Cells(RNum, "S") = .Range("J11") '<<<
            shDest.Cells(RNum, "T") = .Range("K11") '<<<
            shDest.Cells(RNum, "U") = .Range("M11") '<<<
            shDest.Cells(RNum, "V") = .Range("N11") '<<<
            shDest.Cells(RNum, "W") = .Range("O11") '<<<
            shDest.Cells(RNum, "X") = .Range("P11") '<<<
            shDest.Cells(RNum, "Y") = .Range("F11") '<<<
            shDest.Cells(RNum, "Z") = .Range("E11") '<<<
            shDest.Cells(RNum, "AA") = .Range("H11") '<<<
            ThisWorkbook.Sheets("Foglio1").Cells(RNum + 1, "AB") = Range("H12").Value '<<<
        End With
        wkNew.Close savechanges:=False
        Set wkNew = Nothing
        Set shOrig = Nothing
        Set shDest = Nothing
    End If
End Sub
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 18:23

tra l'altro, non so se sia semplice da eseguire, sarebbe molto comodo in fase di verifica che il nome file sia un hyperlink al file specifico cosi che io possa cliccandolo semplicemente aprire direttamente il file di origine per verificare se e cosa mi ha copiato sulla lista generale.

Ho notato che nei 6000 file che ho ci sono svariate versioni della scheda che negli anni ha modificato la struttura del file di base stesso infatti ho dovuto inserire nelle stringhe di codice vba altre celle da copiare in ordine per estrapolare i dati che mi servono anche in file diversi.

Per esempio: il cognome cliente nelle vecchie schede è in c5 e nelle nuove invece è in e7 per via delle modifiche strutturali apportate nel corso del tempo, quindi ho aggiunto anche l'estrapolazione della cella e7 in tutti i 6000 file.
Tale cella copiata risulterà vuota nei vecchi file e compilata con il cognome in quelli nuovi.
In un secondo tempo con i filtri ed un po di pazienza me li metterò in ordine.
Sarebbe comodo se all'inizio di ogni riga ci fosse il nome completo del file di origine da poter cliccare per aprire direttamente la scheda di riferimento per effettuare le dovute verifiche. Secondo voi è possibile? sono veramente una schiappa :undecided:
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 07/12/13 19:51

Ok, quindi mi pare che hai scoperto che erano i file da cui copiavi che non contenevano tutti le stesse informazioni nelle stesse celle...

Quanto a riportare il nome del file, in realta' ho cannato a copiarti l' istruzione da inserire; nel formato dell' ultima macro l' istruzione giusta e':
Codice: Seleziona tutto
      With shOrig        'Esistente
            shDest.Cells(RNum, "A") = NFile      'DA AGGIUNGERE in questa posizione

Attenzione-1: se metti il nome file in colonna A allora devi shiftare tutti gli altri dati importati di 1 colonna; per questo devi aggiornare tutte le istruzioni .

Per aggiungere un hyperlink al file:
Codice: Seleziona tutto
      With shOrig        'Esistente
            shDest.Cells(RNum, "A") = NFile      'DA AGGIUNGERE
'Aggiungere ulteriormente:
            shDest.Hyperlinks.Add Anchor:= shDest.Cells(RNum, "A"), Address:= _
                 "C:\Users\MY CREDIT\Desktop\PROVA MACRO\" & NFile , ScreenTip:=NFile

Attenzione-2 pero': quando cambi la directory dei tuoi file devi modificarla sia nella Sub CARICA_DATI_DIRETTO che nella Sub Fimp(NFile). Per evitare questo la cosa piu' semplice e' che dichiari una variabile comune e la usi per la directory, sia all' interno della Sub CARICA_DATI_DIRETTO che della Sub Fimp(NFile); cioe'

Codice: Seleziona tutto
Dim myPath as String          'RIGOROSAMENTE IN TESTA AL MODULO

Sub CARICA_DATI_DIRETTO()
myPath= "C:\Users\MY CREDIT\Desktop\PROVA MACRO"
ChDir myPath
'etc etc


Sub Fimp(NFile)
Dim wkNew As Workbook
Dim shOrig As Worksheet, shDest As Worksheet
Dim RNum As Long
    Set wkNew = Workbooks.Open(Filename:=NFile)
    If Not wkNew Is Nothing Then
        Set shOrig = wkNew.Sheets("TELEFONATA")
        Set shDest = ThisWorkbook.Sheets("Foglio1")
        RNum = shDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With shOrig
            shDest.Cells(RNum, "A") = NFile      'DA AGGIUNGERE
'Aggiungere ulteriormente:
            shDest.Hyperlinks.Add Anchor:= shDest.Cells(RNum, "A"), Address:= _
                 myPath & "\" & NFile , ScreenTip:=NFile
' etc etc


Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 07/12/13 20:06

Non l' ho collaudata, ma penso che potresti sostituire tutta questa parte
    With shOrig
    shDest.Cells(RNum, "A") = .Range("A1") '<<<
    'etc
    'etc
    End With
con queste istruzioni:
Codice: Seleziona tutto
myList = Array("A1", "B7", "B9", "E12", "F12")    '<<< Le celle che vanno in prima, seconda, terza, etc colonna
With shOrig
    shDest.Cells(RNum, "A") = NFile      'DA AGGIUNGERE
    shDest.Hyperlinks.Add Anchor:= shDest.Cells(RNum, "A"), Address:= _
           myPath & "\" & NFile , ScreenTip:=NFile
    For I = LBound(myList, 1) To UBound(myList, 1)
        shDest.Cells(RNum, 2 + I - LBound(myList, 1)) = .Range(myList(I))
    Next I
End With

Devi compilare la riga marcata <<< con tutti gli indirizzi da ricopiare nel foglio di riepilogo, a partire dalla colonna 2 (cioe' B, mentre A e' riservata per il nome file).

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 21:05

mi sono decisamente infilato in un discorso ben al di sopra delle mie possibilità... Giustamente tu sei un esperto con profonde conoscenze in vba ma io sono completamente a digiuno quindi non ti seguo..:-(
sarebbe piu facile per me se tu riuscissi a pubblicarmi la formula completa facendomi capire come vanno inserite.. per esempio io ho cercato di modificarla cosi ma evidentemente l'ignoranza che ho in questo campo supera ogni limite quindi non parte proprio la formula proprio perche mi mancano le basi infatti credo di non aver inserito correttamente le tue indicazioni.. ecco quello che ho combinato: Help please :-(
Codice: Seleziona tutto
Dim myPath As String
Sub CARICA_DATI_DIRETTO()
myPath = "C:\Users\MY CREDIT\Desktop\PROVA MACRO"
ChDir myPath
  If MyF = "" Then Exit Sub
  While MyF <> ""
    Call Fimp(MyF)
    MyF = Dir
  Wend
End Sub

Sub Fimp(NFile)
Dim wkNew As Workbook
Dim shOrig As Worksheet, shDest As Worksheet
Dim RNum As Long
    Set wkNew = Workbooks.Open(Filename:=NFile)
    If Not wkNew Is Nothing Then
        Set shOrig = wkNew.Sheets("TELEFONATA")
        Set shDest = ThisWorkbook.Sheets("Foglio1")
        RNum = shDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With shOrig
            shDest.Cells(RNum, "A") = NFile
            shDest.Hyperlinks.Add Anchor:=shDest.Cells(RNum, "A"), Address:= _
                 "C:\Users\MY CREDIT\Desktop\PROVA MACRO\" & NFile, ScreenTip:=NFile
            shDest.Cells(RNum, "B") = .Range("B7") '<<<
            shDest.Cells(RNum, "C") = .Range("B8") '<<<
            shDest.Cells(RNum, "D") = .Range("B9") '<<<
            shDest.Cells(RNum, "E") = .Range("E12") '<<<
            shDest.Cells(RNum, "F") = .Range("F12") '<<<
            shDest.Cells(RNum, "G") = .Range("H12") '<<<
            shDest.Cells(RNum, "H") = .Range("I12") '<<<
            shDest.Cells(RNum, "I") = .Range("J12") '<<<
            shDest.Cells(RNum, "J") = .Range("K12") '<<<
            shDest.Cells(RNum, "K") = .Range("N12") '<<<
            shDest.Cells(RNum, "L") = .Range("O12") '<<<
            shDest.Cells(RNum, "M") = .Range("P12") '<<<
            shDest.Cells(RNum, "N") = .Range("Q12") '<<<
            shDest.Cells(RNum, "O") = .Range("E13") '<<<
            shDest.Cells(RNum, "P") = .Range("F13") '<<<
            shDest.Cells(RNum, "Q") = .Range("H13") '<<<
            shDest.Cells(RNum, "R") = .Range("I13") '<<<
            shDest.Cells(RNum, "S") = .Range("J11") '<<<
            shDest.Cells(RNum, "T") = .Range("K11") '<<<
            shDest.Cells(RNum, "U") = .Range("M11") '<<<
            shDest.Cells(RNum, "V") = .Range("N11") '<<<
            shDest.Cells(RNum, "W") = .Range("O11") '<<<
            shDest.Cells(RNum, "X") = .Range("P11") '<<<
            shDest.Cells(RNum, "Y") = .Range("F11") '<<<
            shDest.Cells(RNum, "Z") = .Range("E11") '<<<
            shDest.Cells(RNum, "AA") = .Range("H11") '<<<
        End With
        wkNew.Close savechanges:=False
        Set wkNew = Nothing
        Set shOrig = Nothing
        Set shDest = Nothing
    End If
End Sub
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 07/12/13 21:19

Mi pare che hai fatto "alquanto bene" ma hai saltato una piccola istruzione:
Codice: Seleziona tutto
ChDir myPath
  MyF = Dir("*.xls")      '<<< Questa l' hai saltata  <<<
  If MyF = "" Then Exit Sub

:D :D
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 07/12/13 21:31

Sei diventato il mio idolo!

adesso cerco di capire la seconda parte per eliminare tutte le stringhe di codice da aggiungere cercando di utilizzare la formula abbreviata dove devo solo mettere in fila le celle da copiare tipo: (A1, B5, C5, C6, F11, ECC ECC)
Comunque ti posto la formula completa funzionante allo stato attuale in modo che rimanga ai posteri :-) magari cerco (con la tua ultima formula) di semplificare l'inserimento delle varie celle da copiare cosi che sia piu semplice per tutti l'inserimento evitando formule chilometriche. spero di riucirci...altrimenti chiederò ancora un tuo aiuto durante la serata :-D
Codice: Seleziona tutto
Dim myPath As String
Sub CARICA_DATI_DIRETTO()
myPath = "C:\Users\MY CREDIT\Desktop\PROVA MACRO"
ChDir myPath
 MyF = Dir("*.xls")
  If MyF = "" Then Exit Sub
  While MyF <> ""
    Call Fimp(MyF)
    MyF = Dir
  Wend
End Sub

Sub Fimp(NFile)
Dim wkNew As Workbook
Dim shOrig As Worksheet, shDest As Worksheet
Dim RNum As Long
    Set wkNew = Workbooks.Open(Filename:=NFile)
    If Not wkNew Is Nothing Then
        Set shOrig = wkNew.Sheets("TELEFONATA")
        Set shDest = ThisWorkbook.Sheets("Foglio1")
        RNum = shDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With shOrig
            shDest.Cells(RNum, "A") = NFile
            shDest.Hyperlinks.Add Anchor:=shDest.Cells(RNum, "A"), Address:= _
                 myPath & "\" & NFile, ScreenTip:=NFile
            shDest.Hyperlinks.Add Anchor:=shDest.Cells(RNum, "A"), Address:= _
                 "C:\Users\MY CREDIT\Desktop\PROVA MACRO\" & NFile, ScreenTip:=NFile
            shDest.Cells(RNum, "B") = .Range("B7") '<<<
            shDest.Cells(RNum, "C") = .Range("B8") '<<<
            shDest.Cells(RNum, "D") = .Range("B9") '<<<
            shDest.Cells(RNum, "E") = .Range("E12") '<<<
            shDest.Cells(RNum, "F") = .Range("F12") '<<<
            shDest.Cells(RNum, "G") = .Range("H12") '<<<
            shDest.Cells(RNum, "H") = .Range("I12") '<<<
            shDest.Cells(RNum, "I") = .Range("J12") '<<<
            shDest.Cells(RNum, "J") = .Range("K12") '<<<
            shDest.Cells(RNum, "K") = .Range("N12") '<<<
            shDest.Cells(RNum, "L") = .Range("O12") '<<<
            shDest.Cells(RNum, "M") = .Range("P12") '<<<
            shDest.Cells(RNum, "N") = .Range("Q12") '<<<
            shDest.Cells(RNum, "O") = .Range("E13") '<<<
            shDest.Cells(RNum, "P") = .Range("F13") '<<<
            shDest.Cells(RNum, "Q") = .Range("H13") '<<<
            shDest.Cells(RNum, "R") = .Range("I13") '<<<
            shDest.Cells(RNum, "S") = .Range("J11") '<<<
            shDest.Cells(RNum, "T") = .Range("K11") '<<<
            shDest.Cells(RNum, "U") = .Range("M11") '<<<
            shDest.Cells(RNum, "V") = .Range("N11") '<<<
            shDest.Cells(RNum, "W") = .Range("O11") '<<<
            shDest.Cells(RNum, "X") = .Range("P11") '<<<
            shDest.Cells(RNum, "Y") = .Range("F11") '<<<
            shDest.Cells(RNum, "Z") = .Range("E11") '<<<
            shDest.Cells(RNum, "AA") = .Range("H11") '<<<
        End With
        wkNew.Close savechanges:=False
        Set wkNew = Nothing
        Set shOrig = Nothing
        Set shDest = Nothing
    End If
End Sub
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 08/12/13 00:53

ho inserito la formula che mi hai consigliato però ho un problema:

myList = Array("A1", "B7", "B9", "E12", "F12") '<<< Le celle che vanno in prima, seconda, terza, etc

nelle parentesi avevo talmente tante celle che non mi basta il campo, c'è il modo di andare a capo nella formula senza che mi dia errore?

comunque sei stato preziosissimo! grazie
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi lorenzominucci » 08/12/13 00:54

PS comunque funziona tutto, lunedì lo testo su piu file, adesso l'ho fatto solo su 60 schede spero di non avere problemi sulle celle che sono state unite.
lorenzominucci
Newbie
 
Post: 9
Iscritto il: 07/12/13 01:16

Re: COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO

Postdi Anthony47 » 10/12/13 02:20

Puoi inserire un "ritorno a capo" senza interrompere l' istruzione usando la sequenza "spazio/Underscore/A-Capo", come nell' esempio:
Codice: Seleziona tutto
myList = Array("A1", "B7", "B9", "E12", "F12", "A1", "B7", "B9", "E12", "F12", _
"A1", "B7", "B9", "E12", "F12", "A1", "B7", "B9", "E12", "F12", "A1", "B7", "B9", _
"E12", "F12", "A1", "B7", "B9", "E12", "F12", "A1", "B7", "B9", "E12", "F12", "A1", _
"B7", "B9", "E12", "F12", "A1", "B7", "B9", "E12", "F12", "A1", "B7", "B9", "E12", "F12")

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13885
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "COPIARE DATI DA 6000 FILE EXCEL IN UN UNICO FOGLIO":


Chi c’è in linea

Visitano il forum: raimea, wallace&gromit e 10 ospiti