|
|
Rank: Newbie
Iscritto dal : 10/2/2010
Posts: 4
|
Buona domenica a tutti. Come da titolo ho la necessità di creare un foglio riepilogo, pescando da più fogli (circa 100). I fogli fanno parte di un unico file, l'origine è uguale per tutti i fogli (range c4:f15) premetto che l'origine e il risultato di campi calcolati per cui nel foglio "Riepilogo" vanno riportati solo i valori e non le formule. Questa macro fa ciò che voglio ma mi riporta anche le formule per cui non va bene, e oltretutto non riesco a modificarla  Code:Sub RaggAll()
'
RiepSh = "Riepilogo" 'Nome del foglio in cui fai il riepilogo
CopyC = "c4:f15" 'Colonne e prima riga da copiare
For I = 1 To ThisWorkbook.Worksheets.Count
Sheets(I).Select
If ActiveSheet.Name <> RiepSh Then
LastR = Range("A" & Rows.Count).End(xlUp).Row
Range(CopyC).Resize(LastR).Copy _
Destination:=Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
MsgBox "Fatto, ho copiato tutto"
End Sub
Grazie a prescindere Nunzio
|
|
|
|
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
[quote=nunzio67 Code:Sub RaggAll()
'
RiepSh = "Riepilogo" 'Nome del foglio in cui fai il riepilogo
CopyC = "c4:f15" 'Colonne e prima riga da copiare
For I = 1 To ThisWorkbook.Worksheets.Count
Sheets(I).Select
If ActiveSheet.Name <> RiepSh Then
LastR = Range("A" & Rows.Count).End(xlUp).Row
Range(CopyC).Resize(LastR).Copy _
Destination:=Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
MsgBox "Fatto, ho copiato tutto"
End Sub
Grazie a prescindere Nunzio[/quote] dopo Next I aggiungi queste righe: Sheets("Riepilogo").Activate Cells.Select Selection.Copy Range("a1").PasteSpecial Paste:=xlPasteValues saluti Giap
|
|
Rank: Newbie
Iscritto dal : 10/2/2010
Posts: 4
|
a10n11 ha scritto:[quote=nunzio67 Code:Sub RaggAll()
'
RiepSh = "Riepilogo" 'Nome del foglio in cui fai il riepilogo
CopyC = "c4:f15" 'Colonne e prima riga da copiare
For I = 1 To ThisWorkbook.Worksheets.Count
Sheets(I).Select
If ActiveSheet.Name <> RiepSh Then
LastR = Range("A" & Rows.Count).End(xlUp).Row
Range(CopyC).Resize(LastR).Copy _
Destination:=Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
MsgBox "Fatto, ho copiato tutto"
End Sub
Grazie a prescindere Nunzio dopo Next I aggiungi queste righe: Sheets("Riepilogo").Activate Cells.Select Selection.Copy Range("a1").PasteSpecial Paste:=xlPasteValues saluti Giap[/quote] Grazie Giap per l'interessamento, ma anche con la tua aggiunta fa le stesse cosa di prima, ovvero continua a copiarmi le formule contenute all'interno delle celle d'origine. Grazie Nunzio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve certo che le copia, ma le istruzioni che ti ho suggerito servono appunto per eliminarle. mi mostri come hai corretto la macro? saluti Giap
|
|
Rank: Newbie
Iscritto dal : 10/2/2010
Posts: 4
|
a10n11 ha scritto:salve
certo che le copia, ma le istruzioni che ti ho suggerito servono appunto per eliminarle.
mi mostri come hai corretto la macro?
saluti
Giap In primis debbo chiederti scusa in quanto ho erroneamente ringraziato un'altro utente. Chiedo umilmente scusa. Di seguito la macro modificata in base al tuo suggerimento: Code:Sub RaggAll()
'
RiepSh = "Riepilogo" '<<< Nome del foglio in cui fai il Raggruppamento
CopyC = "c4:f15" '<<<Colonne e prima riga da copiare
For I = 1 To ThisWorkbook.Worksheets.Count
Sheets(I).Select
If ActiveSheet.Name <> RiepSh Then
LastR = Range("c" & Rows.Count).End(xlUp).Row
Range(CopyC).Resize(LastR).Copy _
Destination:=Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
Sheets("Riepilogo").Activate
Cells.Select
Selection.Copy
Range("a1").PasteSpecial Paste:=xlPasteValues
MsgBox "Fatto ho copiato tutto"
End Sub Grazie Nunzio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve se dici che non funziona, sarebbe utile vedere un estratto del tuo tuo foglio con le formule da copiare. La modifica alla macro che ti ho suggerito non è altro che una forma di copia e incolla speciale valori. saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:nunzio67 ha scritto:Code:Sub RaggAll()
'
RiepSh = "Riepilogo" 'Nome del foglio in cui fai il riepilogo
CopyC = "c4:f15" 'Colonne e prima riga da copiare
For I = 1 To ThisWorkbook.Worksheets.Count
Sheets(I).Select
If ActiveSheet.Name <> RiepSh Then
LastR = Range("A" & Rows.Count).End(xlUp).Row
Range(CopyC).Resize(LastR).Copy _
Destination:=Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
MsgBox "Fatto, ho copiato tutto"
End Sub
Grazie a prescindere Nunzio dopo Next I aggiungi queste righe: Sheets("Riepilogo").Activate Cells.Select Selection.Copy Range("a1").PasteSpecial Paste:=xlPasteValues saluti Giap Anziché inserire solo Range("a1").PasteSpecial Paste:=xlPasteValuesprova a inserire Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
facci sapere; -)) Buon pomeriggio, eZio
|
|
|
Guest |
