|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
devo risolvere il mio attuale problema:
-ho 4 file excel aperti (il 1^ file nominato PRIMO_FILE)
-il 4^ file è attivo
dovrei adattare questa macro
Sub colora ()
Dim ws As Worksheet
For n = 4 To Worksheets.Count
With Sheets(n)
Set Rng = .UsedRange
For Each cl In Rng
If cl.Interior.ColorIndex = 3 Then
.Tab.Color = 255
Exit For
End If
Next
End With
Set Rng = Nothing
Next
End Sub
affinché trovi se, dal 4^ foglio all’ultimo del file attivo, ce n’è uno o più con le celle colorate di rosso; in caso affermativo copi tali fogli nel PRIMO_FILE, dopo il suo 1^ foglio, e riprenda la ricerca nel 4^ file continuandola dal punto in cui era rimasto al momento della copia.
A intuito credo che si debba agire nella riga
.Tab.Color = 255
della sub, scrivendo un codice o una chiamata (Call di altra sub contenete i riferimenti) in modo che al verificarsi di tale condizione (If cl.Interior.ColorIndex = 3) il foglio che la contiene venga copiato nel 2^ foglio del PRIMO_FILE
In volgare villano, tale sub potrebbe contenere (il condizionale è obbligatorio) un codice come questo:
Activesheet.Copy After:=Workbooks( _
"PRIMO_FILE.xlsm").Sheets(1)
che ovviamente andrebbe scritto in modo esatto.
Sicuramente la soluzione è assai più elegante, ma non riesco proprio a scriverla :-))
Grazie assai, buona giornata
eZio
|
|
|
|
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve prova questa (Macro nel 4 File) Sub CopiaColori() Dim WB1 As Workbook Dim WB As Workbook Set WB1 = ActiveWorkbook Set WB = Workbooks("PRIMO_FILE.xlsx") cnt = 1 For n = 4 To WB1.Worksheets.Count With WB1.Sheets(n) If .Tab.Color = 255 Then .Copy After:=WB.Sheets(cnt) cnt = cnt + 1 End If End With Next Set WB = Nothing Set WB1 = Nothing End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
la tua velocità nel dare la soluzione è sorprendente...!!
la macro lavora senza dare errori, ma non copia il foglio nel PRIMO_FILE.
Empiricamente ho colorato di rosso (che nella sub è definito 255) la linguetta del foglio (nel 4^ file) che dovrebbe copiare nel PRIMO_FILE, col risultato che l'ha copiato.
Forse nel gruppo di istruzioni
With WB1.Sheets(n)
If .Tab.Color = 255 Then
.Copy After:=WB.Sheets(cnt)
cnt = cnt + 1
End If
End With
si dovrebbe cambiare l'istruzione della riga
If .Tab.Color = 255 Then
che era nella macro di apertura del 3d (che si riferiva alla colorazione della liguetta del foglio)?
Grazie assai,
eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
aetio ha scritto:Ciao,
la tua velocità nel dare la soluzione è sorprendente...!!
la macro lavora senza dare errori, ma non copia il foglio nel PRIMO_FILE.
Empiricamente ho colorato di rosso (che nella sub è definito 255) la linguetta del foglio (nel 4^ file) che dovrebbe copiare nel PRIMO_FILE, col risultato che l'ha copiato.
Forse nel gruppo di istruzioni
With WB1.Sheets(n)
If .Tab.Color = 255 Then
.Copy After:=WB.Sheets(cnt)
cnt = cnt + 1
End If
End With
si dovrebbe cambiare l'istruzione della riga
If .Tab.Color = 255 Then
che era nella macro di apertura del 3d (che si riferiva alla colorazione della liguetta del foglio)?
Grazie assai,
eZio salve con il foglio che ha la Tab colorata attivo, attiva la finestra immediata in vba (menù visualizza>finestra mimmediata) digita nell'area "immediata" : ?ActiveSheet.Tab.Color e dai invio guarda il valoreche restituisce saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:
con il foglio che ha la Tab colorata attivo, attiva la finestra immediata in vba (menù visualizza>finestra mimmediata)
digita nell'area "immediata" : ?ActiveSheet.Tab.Color
e dai invio
guarda il valoreche restituisce
restituisce Falso Grazie assai, eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
aetio ha scritto:Ciao,
restituisce
Falso
Grazie assai,
eZio salve se restituisce Falso significa che il foglio attivo non ha la linguetta colorata saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:
se restituisce Falso significa che il foglio attivo non ha la linguetta colorata
E' giusto che il foglio attivo non abbia la linguetta colorata. La macro deve trovare nei fogli del 4^ file (dal 4^ foglio all'ultimo) se ve n'è uno con celle colorate di rosso (255). Se lo trova copia quel foglio (o quei fogli se ne trova più di uno) nel file PRIMO_FILE e si riposiziona nel 4^ file nel punto in cui ha effettuato l'operazione per continuare il suo lavoro. Grazie assai, anche per la tua immensa pazienza. Buona serata. eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
aetio ha scritto:Ciao, a10n11 ha scritto:
se restituisce Falso significa che il foglio attivo non ha la linguetta colorata
E' giusto che il foglio attivo non abbia la linguetta colorata. La macro deve trovare nei fogli del 4^ file (dal 4^ foglio all'ultimo) se ve n'è uno con celle colorate di rosso (255). Se lo trova copia quel foglio (o quei fogli se ne trova più di uno) nel file PRIMO_FILE e si riposiziona nel 4^ file nel punto in cui ha effettuato l'operazione per continuare il suo lavoro. Grazie assai, anche per la tua immensa pazienza. Buona serata. eZio salve quello che ti avevo suggerito, serviva per capire quale colore fosse assegnato alla linguetta del foglio, quindi devi ripetere l'operazione rendendo attivo il foglio che ha la linguetta colorata. saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:
quello che ti avevo suggerito, serviva per capire quale colore fosse assegnato alla linguetta del foglio, quindi devi ripetere l'operazione
rendendo attivo il foglio che ha la linguetta colorata.
chiedo scusa, forse mi sono espresso male, ma in questi file non ho fogli con linguette colorate; ho fogli con celle colorate di rosso che la macro individua, copiando tali fogli nel file PRIMO_FILE. Credo che nella macro Sub CopiaColori() Dim WB1 As Workbook Dim WB As Workbook Set WB1 = ActiveWorkbook Set WB = Workbooks("PRIMO_FILE.xlsx") cnt = 1 For n = 4 To WB1.Worksheets.Count With WB1.Sheets(n) If .Tab.Color = 255 Then.Copy After:=WB.Sheets(cnt) cnt = cnt + 1 End If End With Next Set WB = Nothing Set WB1 = Nothing End Sub l'errore risieda nella riga If .Tab.Color = 255 Thenche dà come condizione la linguetta colorata, mentre dovrebbe dare la presenza, nel foglio, di celle colorate di rosso seguendo la logica With WB1.Sheets(n)
Set Rng = .UsedRange
For Each cl In Rng
If cl.Interior.ColorIndex = 3 Then
.Copy After:=WB.Sheets(cnt)Ho provato a scrivere questa macro adattando i codici Sub zCopia_Foglio() Dim WB1 As Workbook Dim WB As Workbook Dim ws As Worksheet Set WB1 = ActiveWorkbook Set WB = Workbooks("STUDIO_2-REGIA.xlsm") cnt = 1 For n = 4 To WB1.Worksheets.Count With WB1.Sheets(n) Set rng = .UsedRange For Each cl In rng If cl.Interior.ColorIndex = 3 Then .Copy After:=WB.Sheets(cnt) cnt = cnt + 1 Exit For End If Next End With Set rng = Nothing Set WB = Nothing Set WB1 = Nothing Next End Sub ma restituisce Errore di run-time '91' : Variabile oggetto o variabile del bolcco With non impostatala riga colorata di giallo è With WB1.Sheets(n) Grazie assai, eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
aetio ha scritto:Ciao,
chiedo scusa, forse mi sono espresso male, ma in questi file non ho fogli con linguette colorate; ho fogli con celle colorate di rosso che la macro individua, copiando tali fogli nel file PRIMO_FILE.
Credo che nella macro
Sub CopiaColori()
Dim WB1 As Workbook
Dim WB As Workbook
Set WB1 = ActiveWorkbook
Set WB = Workbooks("PRIMO_FILE.xlsx")
cnt = 1
For n = 4 To WB1.Worksheets.Count
With WB1.Sheets(n)
If .Tab.Color = 255 Then
.Copy After:=WB.Sheets(cnt)
cnt = cnt + 1
End If
End With
Next
Set WB = Nothing
Set WB1 = Nothing
End Sub
l'errore risieda nella riga
If .Tab.Color = 255 Then
che dà come condizione la linguetta colorata, mentre dovrebbe dare la presenza, nel foglio, di celle colorate di rosso seguendo la logica
With WB1.Sheets(n)
Set Rng = .UsedRange
For Each cl In Rng
If cl.Interior.ColorIndex = 3 Then
.Copy After:=WB.Sheets(cnt)
Ho provato a scrivere questa macro adattando i codici
Sub zCopia_Foglio()
Dim WB1 As Workbook
Dim WB As Workbook
Dim ws As Worksheet
Set WB1 = ActiveWorkbook
Set WB = Workbooks("STUDIO_2-REGIA.xlsm")
cnt = 1
For n = 4 To WB1.Worksheets.Count
With WB1.Sheets(n)
Set rng = .UsedRange
For Each cl In rng
If cl.Interior.ColorIndex = 3 Then
.Copy After:=WB.Sheets(cnt)
cnt = cnt + 1
Exit For
End If
Next
End With
Set rng = Nothing
Set WB = Nothing
Set WB1 = Nothing
Next
End Sub
ma restituisce Errore di run-time '91' : Variabile oggetto o variabile del bolcco With non impostata
la riga colorata di giallo è
With WB1.Sheets(n)
Grazie assai,
eZio
Salve forse non riusciamo a focalizzare il problema allo stesso modo. Se mi mostri la macro che controlla il colore della linguetta, io presumo che sia il colore della, linguetta che determini la condizione. Con quest'ultimo chiarimento la situazione cambia. La macro che hai scritto è corretta se non fosse che scarichi dalla memoria le variabili oggetto al primo giro del ciclo For. sposta le seguenti righe: Set rng = Nothing Set WB = Nothing Set WB1 = Nothing dopo la riga con l'istruzione Next saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao, a10n11 ha scritto:
forse non riusciamo a focalizzare il problema allo stesso modo.
alla fine l'obiettivo è stato SEMPRE raggiunto in modo perfetto. ;-)) Riassumendo: -ho 4 file excel aperti (il 1^ file nominato PRIMO_FILE) -il 4^ file è attivo La macro deve: -trovare se, dal 4^ foglio all’ultimo del file attivo, ce n’è uno o più con le celle colorate di rosso -in caso affermativo copia tali fogli nel PRIMO_FILE, dopo il suo 1^ foglio, e riprende la ricerca nel 4^ file continuandola dal punto in cui era rimasto al momento della copia. Con le ultime correzioni, la macro "finale" è: Sub zCopia_Foglio() Dim WB1 As Workbook Dim WB As Workbook Dim ws As Worksheet Set WB1 = ActiveWorkbook Set WB = Workbooks("STUDIO_2-REGIA.xlsm") cnt = 1 For n = 4 To WB1.Worksheets.Count With WB1.Sheets(n) Set rng = .UsedRange For Each cl In rng If cl.Interior.ColorIndex = 3 Then .Copy After:=WB.Sheets(cnt) cnt = cnt + 1 Exit For End If Next End With Next Set rng = Nothing Set WB = Nothing Set WB1 = Nothing End Sub Esito: gira perfettamente ;-)) Grazie assai, buona serata eZio .
|
|
|
Guest |
