disponi in ordine alfabetico i nuovi inserimenti

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao a tutti,

avrei bisogno di disporre in ordine alfabetico i record che inserisco tramite il seguente codice, basandomi sulla colonna B

Sub CopiaDatiE_AggiungiMese()
    Dim wsPrecedente As Worksheet
    Dim wsAttivo As Worksheet
    Dim valoreCercato As String
    Dim dataInserire As String
    Dim cellaTrovata As Range
    Dim rigaDestinazione As Long
    Dim rigaOrigine As Long
    Dim i As Integer
    
    ' Imposta i fogli
    Set wsAttivo = ActiveSheet
    
    ' Trova il foglio precedente
    If ActiveSheet.Index = 1 Then
        MsgBox "Non c'è un foglio precedente a quello attivo.", vbExclamation
        Exit Sub
    End If
    Set wsPrecedente = Sheets(ActiveSheet.Index - 1)
    
    ' 1. Inputbox per il valore da cercare nella colonna A
    valoreCercato = InputBox("Inserisci il valore da cercare nella colonna A:", "Ricerca Record")
    
    ' Se l'inputbox è vuota o annullata, esci
    If valoreCercato = "" Then Exit Sub
    
    ' 2. Inputbox per la data da inserire nella colonna F
    dataInserire = InputBox("Inserisci la data da inserire nella colonna F (gg/mm/aa):", "Inserimento Data")
    
    ' Se la data è vuota o annullata, esci
    If dataInserire = "" Then Exit Sub
    
    ' Verifica se l'input è una data valida
    If Not IsDate(dataInserire) Then
        MsgBox "Il valore inserito non è una data valida.", vbCritical
        Exit Sub
    End If
    
    ' Cerca il valore nella colonna A del foglio precedente
    Set cellaTrovata = wsPrecedente.Columns("A").Find(What:=valoreCercato, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not cellaTrovata Is Nothing Then
        rigaOrigine = cellaTrovata.Row
        
        ' Trova la prima riga libera nel foglio attivo (basandosi sulla colonna A)
        rigaDestinazione = wsAttivo.Cells(wsAttivo.Rows.Count, "A").End(xlUp).Row + 2
        
        ' Copia le righe (riga trovata + riga sotto) da A a S
        ' Nota: c'era un +1 in rigaDestinazione + 1 che ho rimosso per incollare subito dopo l'ultima riga
        wsPrecedente.Range("A" & rigaOrigine & ":S" & rigaOrigine + 1).Copy _
            Destination:=wsAttivo.Range("A" & rigaDestinazione)
            
        ' Aggiungi la data inserita nella colonna F (colonna 6) delle righe appena copiate
        For i = 0 To 1
            wsAttivo.Cells(rigaDestinazione + i, 6).Value = CDate(dataInserire)
            wsAttivo.Cells(rigaDestinazione, 7).Value = "PAGATO"
            wsAttivo.Cells(rigaDestinazione, 13).Value = "Si"
        
        Next i
        
        MsgBox "Dati copiati e data aggiornata con successo!", vbInformation
    Else
        MsgBox "Valore non trovato.", vbCritical
    End If

End Sub

Che devo aggiungere per arrivare al risultato ?

Grazie mille a chi vorrà aiutarmi

[LukeRedsPartecipante LukeReds Karma: 19 pts]

ciao

per ordinare dati che iniziano ad es in B1 (vale se non ci sono celle vuote in mezzo al range) dopo che hai caricato i dati (non ho guardato il tuo codice)

Range("B1").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo

[FrasubbPartecipante Frasubb Karma: 1 pt]

@lukereds grazie per la tua risposta.

 Ci sono celle vuote, ovvero … B1 piena, B2 vuota, B3 piena, B4 vuota e così via.

 Il tuo codice ancora non l’ho provato, c’è da cambiare qualcosa a questo punto ?

 Grazie !

[LukeRedsPartecipante LukeReds Karma: 19 pts]

 se hai celle vuote devi dare il range totale quindi  supposta l'ultima riga Ur, ricavabile con

Ur=range("B" & rows,count),end(xlup).row

Range("B1B" & Ur).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo

[FrasubbPartecipante Frasubb Karma: 1 pt]

ok grazie.

 Spero di spiegarmi meglio, dicendo che devo ordinare tutto ciò che rientra nel range A2:S200 ma basandosi sulla colonna B che contiene cognomi

[LukeRedsPartecipante LukeReds Karma: 19 pts]

ah ok, in questo caso (supponendo non ci siano intestazioni in riga 2, altrimenti va inserito Header:=xlYes al posto di xlNo)

Range("A2:S200").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

[FrasubbPartecipante Frasubb Karma: 1 pt]

Scusa @lukereds, ma questo lo devo mettere ?

Ur=range("B" & rows,count),end(xlup).row

oltre a questo ovviamente

Range("A2:S200").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

 

va bene se li inserisco fra queste due righe ?

 Next i
        
        MsgBox "Dati copiati e data aggiornata con successo!", vbInformation

[LukeRedsPartecipante LukeReds Karma: 19 pts]

Ur inidca l'ultima riga in colonna B qundi la successione delle  2 istruzioni è

Ur=range("B" & rows,count),end(xlup).row

Range("A2:S" & Ur).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

se alleghi file o immagine su come sono i dati dopo la tua sub si chiarisce tutto

 

 

[FrasubbPartecipante Frasubb Karma: 1 pt]

@lukereds allego file esempio informandoti che la sub viene attivata premendo F6 e si chiama "CopiaDatiE_AggiungiMese", a me funziona male ma certamente dipende dalla mia incompetenza.

Grazie e scusa

Allegati:

You must be logged in to view attached files.

[LukeRedsPartecipante LukeReds Karma: 19 pts]

allego il file con  la mini sub di ordinamento, basta inserire una "call ordina" dove ti serve (senza usare il pulsante) o inserire direttamente le 2 righe nel tuo codice

NB: avevi scritto " LUCIO" e non "LUCIO", ho cancellato lo spazio davanti alla L

Allegati:

You must be logged in to view attached files.

[FrasubbPartecipante Frasubb Karma: 1 pt]

Grazie mille @lukereds

[LukeRedsPartecipante LukeReds Karma: 19 pts]

prego   

[Autore]

Articoli