seleziona blocco di righe contigue

[claud]

Buon giorno, ho un foglio di estrazioni lotto, evidenziando una data e facendo girare la macro che vi è inserita, mi seleziona un blocco di 180 righe e le incolla in un nuovo foglio, il problema e che variando la data di partenza verrà creato un nuovo foglio così che dopo un certo numero di prove ne avrò molti aperti.
Ora chiede se sia possibile invece che ad ogni variazione di data, le righe create vengano inserite in un unico foglio sovrascrivendo quelle precedenti.
Spero di non essere stato troppo contorto nell'esposizione e ringrazio chi mi potrà aiutare.
Claudio

http://www.filedropper.com/statisticalotto

Uso excel 2007

[claud]

ehm, mi son scordato di specificare che il foglio dove applico la macro e nominato foglio 1
chiedo scusa

[Anthony47]

Se parli della Sub CopiaInterni1, allora potresti creare un foglio che chiami "Output" e poi lo usi per incollarci i dati:

Codice: Seleziona tutto

Sub CopiaInterni1()
Dim r As Long
r = ActiveCell.Row
Sheets("OUTPUT").Range("A1").CurrentRegion.ClearContents
If r <= 180 Then
        Sheets("foglio1").Rows("1:" & r).Copy Sheets("OUTPUT").Range("A1")
    Else
        Sheets("foglio1").Range("1:1, " & (r - 179) & ":" & r).Copy Sheets("OUTPUT").Range("A1")
    End If
End Sub

Fai sapere...

[claud]

Grazie, proprio quello che desideravo..
claudio

[papiriof]

Se parli della Sub CopiaInterni1, allora potresti creare un foglio che chiami "Output" e poi lo usi per incollarci i dati:

Codice: Seleziona tutto

Sub CopiaInterni1()
Dim r As Long
r = ActiveCell.Row
Sheets("OUTPUT").Range("A1").CurrentRegion.ClearContents
If r <= 180 Then
        Sheets("foglio1").Rows("1:" & r).Copy Sheets("OUTPUT").Range("A1")
    Else
        Sheets("foglio1").Range("1:1, " & (r - 179) & ":" & r).Copy Sheets("OUTPUT").Range("A1")
    End If
End Sub

Fai sapere...

Gran bella Macro Velocissima ..addirittura istantanea, Se posso approfittare per chiedere una o due variazioni :
1) Invece di tutte le ruote ... una sola ruota a richiesta e altresì con le 180 variabili a richiesta
2)stessa cosa della richiesta precedente ma copiando solo le righe che siano del mese su cui ho evideziato la data Quindi ad esempio in output le estrazioni di maggio 2019 -8- ....a secondo della variabile 180 questa dovrebbe essere una macro diversa da quella del punto 1 ..... bhe io provo

[Anthony47]

Hai "quotato" me, ma penso che la tua domanda sia per claud; io d'altra parte non saprei interpretare la tua richiesta...

[papiriof]

Hai "quotato" me, ma penso che la tua domanda sia per claud; io d'altra parte non saprei interpretare la tua richiesta...

no intendevo proprio Lei, comunque riformulo la richiesta con l'aiuto di un mio file. Ho tre fogli il primo "Archiio" poi con l'ausilio della tua macro :

Codice: Seleziona tutto

Sub CopiaInterni1()
Dim r As Long
r = ActiveCell.Row 'mi metto sulla riga 2193 quindi r avrà valore 2193
Sheets("OUTPUT").Range("A1").CurrentRegion.ClearContents 'per prima cosa cancello quello che c'è  nel foglio OUTPUT
If r <= 180 Then 'se la riga selezionata è minore o = a 180 .......
        Sheets("Archivio").Rows("1:" & r).Copy Sheets("OUTPUT").Range("A1") 'copio le righe possibili
    Else '
        Sheets("Archivio").Range("1:1, " & (r - 179) & ":" & r).Copy Sheets("OUTPUT").Range("A1")
        '                               
    End If
End Sub

che aziono con CTRL + z ..... succede quello che è evidenziato nel foglio " OUTPUT" ebbene io vorrei che il foglio " OUTPUT" fosse come il foglio3 ovviamente la macro dovrebbe prevedere la richiesta "quale ruota? "




http://www.filedropper.com/modxforum

[Anthony47]

Ah ha, ho provato a scansarmela ma mi hai beccato...

Se ho capito bene, la precedente Sub CopiaInterni1 diventa:

Codice: Seleziona tutto

Sub CopiaInterni121()
Dim r As Long
Dim cRuota As String, ColRuota, ColSpan As Long
'
Sheets("Archivio").Select
r = ActiveCell.Row 'mi metto sulla riga 2193 quindi r avrà valore 2193
Sheets("OUTPUT").Range("A1").CurrentRegion.ClearContents 'per prima cosa cancello quello che c'è  nel foglio OUTPUT
cRuota = Application.InputBox("Ruota da Selezionare (una oppure TUTTE)", "Scelta Ruota", , , , , , 2)
If UCase(cRuota) = "TUTTE" Then
    ColRuota = 4: ColSpan = 11 * 5
Else
    ColSpan = 5
    ColRuota = Application.Match(cRuota, Range("A1:BZ1"), False)
    If IsError(ColRuota) Then
        MsgBox ("Ruota non trovata: " & cRuota)
        Exit Sub
    End If
End If
Sheets("OUTPUT").Range("A1").Resize(1, 3).Value = Range("A1").Resize(1, 3).Value
Sheets("OUTPUT").Range("D1").Resize(1, ColSpan).Value = Cells(1, ColRuota).Resize(1, ColSpan).Value
If r > 180 Then vres = (180 - 1) Else vres = r - 2
Sheets("OUTPUT").Range("A2").Resize(vres + 1, 3).Value = Cells(r - vres, 1).Resize(vres + 1, 3).Value
Sheets("OUTPUT").Range("D2").Resize(vres + 1, ColSpan).Value = Cells(r - vres, ColRuota).Resize(vres + 1, ColSpan).Value
End Sub


Un InputBox consente di indicare la ruota da scegliere, oppure "Tutte"

Ne approfitto per dire che trovo un po' autolesionistico usare come abbreviazione per il lancio di una macro la combinazione Contr+z, visto che questa abbreviazione corrisponde all'utilissimo comando "Annulla" di Excel.

Ciao

[papiriof]

Grazie Anthony tutto OK