Ciao Baciccia, anche se nel foglo "Archivio" ci sono solo le estrazioni di Bari ti puoi rendere conto di come funziona quanto vuoi ottenere l'importante è che almeno siano coincidenti i riferimenti a quelli che io ho messo nel #10 e cioè Bari sia nella cella D2 le relative estrazioni siano messe nell'intervallo D3: H...... almeno 147 cioè ci siano almeno 144 estrazioni. Atteso che il foglio di destinazione sia organizzato in questa maniera: ecco la macro che dovrai mettere sul foglio denominato "Archivio"
Sub CopiaDatiRuota144()
Dim wsOrigine As Worksheet
Dim wsDestinazione As Worksheet
Dim rigaInizio As Long
Dim colonnaInizio As Long
Dim ultimaRigaOrigine As Long
Dim primaRigaOrigine As Long
Dim i As Long
Dim datiCopia(1 To 144, 1 To 8) As Variant
Dim nomeRuota As String
' Assegna i fogli di origine e destinazione
Set wsOrigine = ThisWorkbook.Sheets("Archivio")
Set wsDestinazione = ThisWorkbook.Sheets("Foglio1") ' occhio se lo chiami diversamente 'cambia in un nome qui + rappresentativo
' Trova la cella attiva come punto di partenza
rigaInizio = ActiveCell.Row
colonnaInizio = ActiveCell.Column
' Determina il nome della ruota dalla riga 2
nomeRuota = wsOrigine.Cells(2, colonnaInizio).Value
' Determina l'ultima riga di origine da copiare
ultimaRigaOrigine = rigaInizio
primaRigaOrigine = ultimaRigaOrigine - 143
' Controlla se c'è abbastanza spazio per copiare 144 righe
If primaRigaOrigine < 1 Then
MsgBox "Non ci sono abbastanza righe sopra la cella selezionata per copiare 144 righe.", vbExclamation
Exit Sub
End If
' Copia i dati nelle variabili
For i = 0 To 143
' Copia le prime tre colonne
'datiCopia(i + 1, 1) = wsOrigine.Cells(primaRigaOrigine + i, 1).Value
'datiCopia(i + 1, 2) = wsOrigine.Cells(primaRigaOrigine + i, 2).Value
datiCopia(i + 1, 1) = wsOrigine.Cells(primaRigaOrigine + i, 3).Value
' Copia le cinque colonne relative alla ruota
datiCopia(i + 1, 2) = wsOrigine.Cells(primaRigaOrigine + i, colonnaInizio).Value
datiCopia(i + 1, 3) = wsOrigine.Cells(primaRigaOrigine + i, colonnaInizio + 1).Value
datiCopia(i + 1, 4) = wsOrigine.Cells(primaRigaOrigine + i, colonnaInizio + 2).Value
datiCopia(i + 1, 5) = wsOrigine.Cells(primaRigaOrigine + i, colonnaInizio + 3).Value
datiCopia(i + 1, 6) = wsOrigine.Cells(primaRigaOrigine + i, colonnaInizio + 4).Value
Next i
' Incolla i dati nel foglio di destinazione
wsDestinazione.Range("b2").Resize(144, 8).Value = datiCopia
' Scrivi la dicitura nella cella D3
wsDestinazione.Range("D1").Value = "esame ruota di " & nomeRuota
MsgBox "Dati copiati con successo!", vbInformation
End Sub
questa macro va messa, con un bottone nel foglio 1, nello stesso modulo dell'altra macro
Come procedere 1) mettiti sulla cella D147 "Archivio"e chlicca sul bottone che avrai messo sul foglio archivio che scatenerà la macro suddetta e porterà l'intervallo sul foglio 1
.
