Copiare i valori di alcune celle di più files in un altro ri

[Cesare2010]

Buonasera a tutti,
sono ancora Cesare con un nuovo consiglio da chiedere.
Ho un file .xlt, con il quale creo, annualmente, files .xls (almeno 20), ovviamente ognuno con un suo identificativo (1° Turno, 2° Turno, ....., 20° Turno).
All'interno di ciascun file vi è una cartella ("Conteggi") dalla quale vengono prelevati (copy) i valori di alcune celle - non proprio in sequenza (A1:B1, B6:S10; B26:B27, F25:G26, M27:M28, R26:S32 - N.B.: su altre celle vi è del testo oppure formule) - e riportati su un file "Repilogo" contenente tanti fogli per quanti file di lavoro creati che hanno lo stesso nome di questi ultimi.
Il lavoro di Copia/IncollaSpecialeValori è sostenuto da una macro creata per il 99% con il registratore automatico; pertanto piuttosto lunga (qualora dovesse servire, potrei postarla).
Alla creazione di ciascun file (1° Turno, 2° Turno, ....., 20° Turno) è d'uopo che debbano essere corrette, all'interno della macro già predisposta le stringhe che selezionano sia il foglio dove andare ad inserire i dati prelevati dal file sul quale si sta lavorando sia il nome di quest'ultimo.
Di certo c'è una soluzione per evitare tutto il cennato lavoro e che di certo riduca anche le stringhe della macro.
Can anyone help me?
Grazie in anticipo.
Cesare

[ricky53]

Yes. We can!
Where is the code?

Invia un file di esempio (ATTENZIONE: senza dati riservati) e ...

Però la tua descrizione non è che si aproprio chiarissima !!!

Vediamo il file e poi ...

[raimea]

questa e ' parte di una macro che preleva dati da altri file - altre cartelle
e con le opportune modifiche forse potrai utilizzare

Codice: Seleziona tutto

 Range("A1").Select                       '1mo prelevamnto
percorso = "D:\totosi/scommesse 2010"     ' <<< la cartella dove prelevo il dato
file = "luga.fibonacci.xls"    ' <<< il file dove preleva
Workbooks.Open percorso & "\" & file
Workbooks(file).Worksheets("stampe").Activate   ' <<< il foglio dal quale dove preleva

Application.Run "'luga.fibonacci.xls'!riprsito"  '<<< serve a ripristinare il foglio nel caso fosse chiuso

Range("c3:d33").Select   'il range di dove prelevare
Selection.Copy
 Workbooks("luga.fibonacci.xls").Close SaveChanges:=False
fil = "generale.lugascommesse.xls"    '<<< il file dove devo portare il dato
Sheets("foglio1").Select
Range("f41").Select  ' la cella dove incollare i dati
ActiveSheet.Paste


ciao

[Cesare2010]

Buongiorno.
Hic codex!

Sub TrasferisciDati()

Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"C:\Archivio\Riepilogo.xls", UpdateLinks:=0
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Windows("1° Turno.xls").Activate '<<<<DA CORREGGERE
Sheets("Conteggi").Select
Range("A1:B1").Select
Selection.Copy
Windows("Riepilogo.xls").Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Sheets("Conteggi").Select
Range("B6:S10").Select
Selection.Copy
Windows("Riepilogo.xls").Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Range("B26:B27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Riepilogo.xls").Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("B26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Range("F25:G26").Select
Application.CutCopyMode = False
Selection.Copy
Windows(“Riepilogo.xls”).Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("F25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Range("M27:M28").Select
Application.CutCopyMode = False
Selection.Copy
Windows(“Riepilogo.xls”).Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("M27").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Range("R26:S32").Select
Application.CutCopyMode = False
Selection.Copy
Windows(“Riepilogo.xls”).Activate
Sheets("1° Turno").Select '<<<<DA CORREGGERE
Range("R26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A23").Select
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=True
Windows(“1° Turno.xls”).Activate '<<<<DA CORREGGERE
Range("A23").Select
Sheets("Menu principale").Select
Application.ScreenUpdating = True

End Sub

Chiedo venia per il mio messaggio non del tutto chiaro. Proverò a semplificare/esemplificare.
Ogni mese o periodo temporale creo un file che chiamo: "1° Turno.xls", per il primo mese - "2° Turno.xls", per il secondo - ........ - etc.. Tale file alla fine del mese/periodo viene chiuso ed archiviato. Prima di archiviare ciascun file, però, tramite la macro sopra esposta, i dati contenuti nel foglio "Conteggi" sono riportati in un file "Riepilogo" in apposito foglio il cui nome è lo stesso del file di provenienza. Al momento, ogni qualvolta creo il file "di lavoro" vado a modificare le stringhe della macro esposta e indicate quali da correggere.

[Anthony47]

Il sistema piu' immediato:

Codice: Seleziona tutto

Sub TrasferisciDati()
TTarget = "1° Turno"      '<<< Unico da modificare   ++++

Application.ScreenUpdating = False
'. . .
Sheets(TTarget).Select
'. . .
'. . .
Windows(TTarget & ".xls").Activate
'. . .


L' istruzione aggiunta e' quella marcata +++; devi poi modificare come da esempi le istruzioni di selezione del foglio e di attivazione del file.

Il resto della macro se funziona e' perfetto…

Per la prossima occasione, valuta la scrittura di righe del tipo
Range("M27:M28").Copy Destination:= Windows(“Riepilogo.xls”). Sheets("1° Turno"). Range("M27")

E per la volta successiva valuta la compilazione di un "array" con gli N intervalli da copiare (guarda la voce "Funzione Array" nel vba help on line), poi usi un ciclo For I=1 to XX (il numero di elementi memorizzati) /Next I per prendere dall' array l' indirizzo dell' intervallo e copiarlo nel foglio di destinazione.

Ciao

[Cesare2010]

Grazie Anthony........ meraviglioso , anche se quel "TTarget" è da modificare su ogni file interessato dal prelievo di dati.

Ho provato ad inserire la stringa (Range("M27:M28")Value.Copy Destination:=...........) al posto delle cinque che controllano il copia/incolla speciale, ma viene generato un errore 438 (Proprietà o metodo non supportato dall'oggetto).

Peraltro, mi sono avventurato anche in una compilazione di "array" - come sotto riportato; anche qui, però, alla stringa di lettura dell'array viene generato un errore: 1004 (metodo 'Range' dell'oggetto' _Global' non riuscito):

Sub CopiaDati()

TTarget = "1° Turno" '<<<<<Questo sarà da cambiare per ogni file "*° Turno.Xls" (!!!!!?????)

Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"C:\Archivio\Riepilogo.xls", UpdateLinks:=0
Sheets(TTarget).Select
Windows(TTarget & ".xls").Activate
Sheets("Conteggi").Select
Range(Array("A1:B1", "B6:S10", "B26:B27", "F25:G26", "M27", "R26:S32")).Select
For I = 1 To 6
I.Copy
Windows("Riepilogo.xls").Activate
Sheets(TTarget).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next I
Range("A23").Select

End Sub

Di sicuro non ho ben capito la filosofia delle due tipologie di scrittura.
Ciao.

[Anthony47]

Se non vuoi modificare TTarget, allora modifica la macro in modo che sia essa a chiedere quale file aprire, usando le istruzioni With Application.FileDialog(msoFileDialogFilePicker) (e successive, fino a Workbooks.Open Filename:=FileAN) che ti sono state suggerite in un' altra discussione.
A quel punto per semplicita' compilerai TTarget con TTarget=Activesheet.Name e procederai con la macro che hai collaudato.

Per quanto riguarda gli errori che hai avuto con gli esperimenti, beh non per nulla avevo detto "la prossima volta" e "la volta successiva": nel frattempo farai un po' di esercizi sull' uso della funzione Array e dell' argomento Destination.

Ciao

[Cesare2010]

Grazie.
Prometto che studierò!
Ciao.

[Cesare2010]

Buona sera a tutti, Cesare scrive.
Premesso che non so se con questo messaggio possa violare qualche regola, spero possa essere perdonato qualora ciò rispondesse a verità, ma ...... dopo un pò di tempo e "qualche" ora di studio sull'argomento Copy Destination, consigliatami dal buon Antony47, credo di aver trovato una ulteriore soluzione al mio problema postato circa un mese fa.
La macro che mi ha dato dei risultati "soddisfacenti" è quella che descrivo di seguito, laddove possa servire per qualcuno:

Sub TrasferisciDati()
'
'Macro che copia i dati contenuti in alcune celle
'del foglio "Conteggi" del file "*° Turno.xls"
'per incollarli nel foglio "*° Turno" del file "Riepilogo.xls"
'
Source = ThisWorkbook.Name
Target = Left(Source, Len(Source) - 4)

Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\Archivio\Riepilogo.xls", UpdateLinks:=0
Workbooks(Source).Activate
Sheets("Conteggi").Select

Range("A1:B1").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("A1")
Range("B6:S10").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("B6")
Range("B26:B27").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("B26")
Range("F25:G26").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("F25")
Range("M27:M28").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("M27")
Range("R26:S32").Copy Destination:=Workbooks("Riepilogo.xls").Sheets(Target).Range("R26")

Application.CutCopyMode = False
Range("A23").Select

Application.ScreenUpdating = True

End Sub

Ma...... non è del tutto perfetta!
Nelle celle del file Source vi sono delle formule.... di tal ché, al momento del trasferimento nel Target, queste vengono riportate con l'ovvia con l'aggiunta del percorso del file di origine.
Non era proprio ciò che mi aspettavo. L'intento era di ricopiare solo i valori.
C'è possibilità di avere qualche consiglio?
Ringrazio in anticipo,

Cesare.

[Anthony47]

C'è possibilità di avere qualche consiglio?

Ad esempio usare PasteSpecial; del tipo (su 2 righe)

Codice: Seleziona tutto

Range("A1:B1").Copy
Workbooks("Riepilogo.xls").Sheets(Target).Range("A1"). PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Ciao

[raimea]

ho avuto lo stesso problema e me lo ha risolto il mitico Sig. anthony47
ti riporto la macro completa che:
mi importa solo i dati indipend se il foglio -origine- sia o meno protetto, toglie avviso di molti dati ecc...,
con i dovuti (e semplici) accorgimenti ai tuoi file sara' ok.
ciao

Codice: Seleziona tutto

percorso = "D:\totosi/scommesse 2010"     ' <<< la cartella dove prelevo il dato
file = "luga-ovr1,5 2010.xls"    ' <<< il file dove preleva
Workbooks.Open percorso & "\" & file
Workbooks(file).Worksheets("1-luga.ovr1,5-Fogl.Base").Activate   ' <<< il foglio dal quale dove preleva

Range("c9:c1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("ac7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 Application.CutCopyMode = False  '<<< toglie avviso di molti dati
 ActiveWorkbook.Close SaveChanges:=False


fil = "generale.lugascommesse.xls"    '<<< il file dove devo portare il dato
Sheets("giornaliero").Select
Range("ac7").Select  ' la cella dove incollare i dati



[Cesare2010]

Grazie Antony, grazie Raimea,
mi vergogno come un bambino sorpreso con le mani nella marmellata. Si trattava esclusivamente del classico uovo di Colombo. Ho, comunque, utilizzato il consiglio del grande Antony anche perché a me è sembrato che la routine del Raimea punti su celle contigue della stessa colonna del file di origine.
Di nuovo grazie e, spero, a presto risentirci.
Cesare