La 1à di nome macroA
- Codice: Seleziona tutto
Sub macroA()
Range("R2:AA" & Range("P14").Value + 1).Copy _
Destination:=Sheets("Strisce").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub
Lavora all’interno di un’altra macro che cicla tutti i fogli e per ogni foglio ciclato interviene la macroA che
copia sempre lo stesso range R2:AA(end) e lo accoda in colonna B del foglio “Strisce”. Quindi molto semplice (spero) Il foglio “Strisce” si riempie fino alla riga 830 mila e rotti(arriveranno 13/14 strisce da 980 mila e rotti righe).
Per adesso stiamo sulle 830 mila righe.
Da questo punto interviene la 2à, macroB, per smistare i dati, dal foglio “Strisce” al foglio “Tutto”.
Questa macro casareccia percorre la colonna I del foglio “Strisce” da i2 fino in fondo per cercare il valore 2,3,4,5 e 6.
Io non sono capace a scrivere del codice che intercetta il valore letto nella cella per accodarlo nella giusta colonna del foglio “Tutto”.
Quindi ho realizzato cinque cicli For per intercettare i cinque valori e accodarli nella giusta colonna del foglio “Tutto”.
--Il ciclo For a --percorre tutta la colonna I cerca il valore 6 e, trovato, copia un rettangolo di 2 righe 10 celle sopra e 10 celle sotto e le accoda sul foglio “Tutto”
in colonna AZ partire dalla cella AZ2
--Il ciclo For b –come sopra cerca il valore 5 accodandolo sul foglio “Tutto” in colonna AN a partire dalla cella AN2
--Il ciclo For c –come sopra cerca il valore 4 accodandolo sul foglio “Tutto” in colonna AB a partire dalla cella AB2
--Il ciclo For d –come sopra cerca il valore 3 accodandolo sul foglio “Tutto” in colonna P a partire dalla cella P2
--Il ciclo For e –come sopra cerca il valore 2 accodandolo sul foglio “Tutto” in colonna D a partire dalla cella D2
Trovati tutti i valori, la macroB, cancella tutti i dati sul foglio “Strisce” e salva il file.
Io ho già una macro “diretta” che dai fogli va a accodare sul foglio “Tutto” ma non la uso perché il foglio “Strisce” è necessario, per ulteriori ricerche.
Anche se i dati vengono cancellati, con la macroB, è solo una copia l’originale è nel gruppo elaborazione Dati.
Nota_1 il tempo trascorso è solo per il collaudo della macro e, finito il collaudo, si cancellano le righe. Di conseguenza si può omettere nella macro di aiuto.
Nota_2 anche disattivare e poi attivare le applicazioni si può omettere nella macro di aiuto.
Le macro A e B funzionano molto bene ma sono lente per la raccolta dati dai fogli fino al traguardo sul foglio “Tutto” trascorrono poco meno di 30 minuti.
In allegato un file con 3 fogli:
1°) Pippo… è uno dei 2123 fogli che devo compilare in questo caso è il 300.mo dove sulla parte dx c’è il range R2:AA(end) che è la parte in esame da copiare.
Con il foglio “Pippo” attivato e si manda in esecuzione la macroA si nota che sul foglio “Strisce”, sotto la linea spessa, viene accodato il range R2:AA(end).
2°) Strisce… che contiene i dati da accodare nelle colonne assegnate sul foglio “Tutto” ATTENZIONE CHE A FINE MACRO I DATI VENGONO CANCELLATI!!!
L’ho manomesso aggiungendo tre volte il valore 6 e quattro volte il valore 5 solo per collaudo macro e la posizione nelle colonne dei valori 6 e 5.
3°) Tutto … il risultato sperato nel più breve tempo possibile. Si realizza mandando in esecuzione la macroB dopo aver cancellato i dati dal foglio.
Infine ho già un’altra macro, copia e accoda, macroC già operativa e funzionante da velocizzare ma la accoderò su questo stesso post quando avrò finito
di trovare le parole giuste per descriverla, anche se è semplice nella struttura, è incasinata nella spiegazione. Così sul post rimarranno tre macro di copia e accoda.
Ringraziando anticipatamente tutti coloro che mi possono aiutare 73 ikwae
https://we.tl/t-RfPgsttjxl
Ho scaricato il file e il link funziona bene.
- Codice: Seleziona tutto
Sub macroB()
Dim t As Date
t = Now
'DISATTIVO LE APPLICACAZIONI PER VELOCIZZARE
Dim xlCal As XlCalculation
With Application
.ScreenUpdating = False
.EnableEvents = False
xlCal = .Calculation
.Calculation = xlCalculationManual
End With
Sheets("Strisce").Select
Dim a As Range
For Each a In Range("I2", Range("I" & Rows.Count).End(xlUp))
If a.Value = "6" Then
a.Select
'COPIA PRONOSTICO, VALORE, DATA E CONCORSO
Range(ActiveCell.Offset(0, -7), ActiveCell.Offset(-1, 2)).Copy _
Destination:=Sheets("Tutto").Range("AZ" & Rows.Count).End(xlUp).Offset(1, 0)
'AZ2-6 punti
End If
Next a
'*************
Dim b As Range
For Each b In Range("I2", Range("I" & Rows.Count).End(xlUp))
If b.Value = "5" Then
b.Select
'COPIA PRONOSTICO,VALORE,DATA E CONCORSO
Range(ActiveCell.Offset(0, -7), ActiveCell.Offset(-1, 2)).Copy _
Destination:=Sheets("Tutto").Range("AN" & Rows.Count).End(xlUp).Offset(1, 0)
'AN2-5 punti
End If
Next b
'*************
Dim c As Range
For Each c In Range("I2", Range("I" & Rows.Count).End(xlUp))
If c.Value = "4" Then
c.Select
'COPIA PRONOSTICO,VALORE,DATA E CONCORSO
Range(ActiveCell.Offset(0, -7), ActiveCell.Offset(-1, 2)).Copy _
Destination:=Sheets("Tutto").Range("AB" & Rows.Count).End(xlUp).Offset(1, 0)
'AB2-4 punti
End If
Next c
'*************
Dim d As Range
For Each d In Range("I2", Range("I" & Rows.Count).End(xlUp))
If d.Value = "3" Then
d.Select
'COPIA PRONOSTICO,VALORE,DATA E CONCORSO
Range(ActiveCell.Offset(0, -7), ActiveCell.Offset(-1, 2)).Copy _
Destination:=Sheets("Tutto").Range("P" & Rows.Count).End(xlUp).Offset(1, 0)
'P2-3 punti
End If
Next d
'*************
Dim e As Range
For Each e In Range("I2", Range("I" & Rows.Count).End(xlUp))
If e.Value = "2" Then
e.Select
'COPIA PRONOSTICO,VALORE,DATA E CONCORSO
Range(ActiveCell.Offset(0, -7), ActiveCell.Offset(-1, 2)).Copy _
Destination:=Sheets("Tutto").Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
'D2-2 punti
End If
Next e
'RIATTIVO LE APPLICATIONI
With Application
.Calculation = xlCal
.EnableEvents = True
.ScreenUpdating = True
End With
'CANCELLARE TUTTI I DATI DEL FOGLIO E SALVARE
Sheets("Strisce").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveWorkbook.Save
'TEMPO TRASCOSO(solo per collaudo macro)
MsgBox Format(Now - t, "HH:MM:SS"), vbInformation, "codice eseguito in........."
Range("A1").Select
End Sub
e non aggiungo altro la tua macro in una manciata di secondi ha trasferito i dati al giusto posto sul foglio “Tutto”