Ho guardato il tuo file, e immagino che l'utente scriva la data di una nuova operazione in colonna D in coda all'elenco preesistente.
A questo punto la macro corrente riordina le date e poi attiva la cella "vuota" accanto alla data appena inserita.
Qualche osservazione:
-Se la cella di colonna E fosse stata popolata prima di colonna D l'utente dovrebbe cercarsi a occhio la riga che stava popolando.
-Sarebbe molto peggio se in colonna E ci fossero due celle vuote (accanto a una data) perche' in questo caso la macro andrebbe in loop (su XL2010 Excel si arresterebbe per le sue impostazioni di sicurezza; su XL2003 credo che il loop si interrompa dopo 200 cicli). Due celle vuote si possono produrre perche' l'utente, dopo la compilazione, si accorge che il nome Cliente e' errato e cancella due o piu' celle adiacenti che lo contengono pensando di poterlo correggere.
-Analogamente e' problematico correggere una data, se l'utente si accorge di averla digitata male.
Tutto questo per dirti che voler mettere subito in ordine potrebbe non essere il modo migliore di operare, soprattutto se chi opera sul foglio non e' chi l'ha progettato.
Quindi il mio suggerimento e' di lasciare l'utente inserire i dati nell'ordine in cui li ha e procedere con un ordinamento solamente su richiesta; ad esempio potresti usare il "doppioclick" sull'intestazione di colonna per fare l'ordinamento secondo i dati di quella colonna, usando questa macro:
- Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Accett As String, CCol As Long, LastD As Long
'
Accett = "D8:E8" '<<< Le colonne in cui e' accettato il DoubleClick
'
If Application.Intersect(Range(Accett), Target.Cells(1, 1)) Is Nothing Then Exit Sub
CCol = Target.Column
LastD = Cells(Rows.Count, "D").End(xlUp).Row
With Range("D11:N" & LastD)
.Sort Key1:=Cells(6, CCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Cancel = True
Target.Offset(2, 0).Cells(1, 1).Select
End Sub
La macro va inserita nello stesso modulo in cui hai inserito l'attuale Sub Worksheet_SelectionChange, che invece va cancellata. La linea marcata <<< va adattata per inserire le colonne su cui il doppioclick e' abilitato, cioe' le colonne su cui vorresti poter fare l'ordinamento; in caso di colonne non adiacenti userai questa notazione:
- Codice: Seleziona tutto
Accett = "D8:E8, L8" 'Colonne D, E ed L
Un prerequisito per il corretto funzionamento del doppioclick e' la rimozione delle forme posizionate nelle intestazioni, la cui utilita' non ho capito.
Fin qui abbiamo fatto in modo diverso (e mi permetto di dire anche "piu' sicuro") le cose che facevi gia'.
Rimane il discorso della tabella che comincia da AB; immagino che lì c'e' un'altra tabella relativa alle Uscite, la cui struttura e' simile alla precedente.
Se vuoi fare anche per questa tabella lo stesso discorso allora la mia proposta e' di modificare macro di "beforedoubleclick" per inserirci un secondo blocco per l'ordinamento sulla seconda tabella; ad esempio:
- Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Accett As String, CCol As Long, LastD As Long, Accett2 As String
'
Accett = "D8:E8, L8" '<<< Le colonne in cui e' accettato il DoubleClick
Accett2 = "AB8:AC8" '<<< Idem
'
If Not Application.Intersect(Range(Accett), Target.Cells(1, 1)) Is Nothing Then
CCol = Target.Column
LastD = Cells(Rows.Count, "D").End(xlUp).Row
With Range("D11:N" & LastD)
.Sort Key1:=Cells(6, CCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Cancel = True
Target.Offset(2, 0).Cells(1, 1).Select
ElseIf Not Application.Intersect(Range(Accett2), Target.Cells(1, 1)) Is Nothing Then
CCol = Target.Column
LastD = Cells(Rows.Count, "AB").End(xlUp).Row
With Range("AB11:AN" & LastD) '<<< Le vere colonne da ordinare
.Sort Key1:=Cells(6, CCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Cancel = True
Target.Offset(2, 0).Cells(1, 1).Select
End If
End Sub
Ovviamente in sostituzione del codice precedente.
Noterai una doppia dedinizione in testa e il secondo blocco che replica le istruzioni del primo; le righe marcate <<< vanno sempre adattate al tuo caso.
Se invece vuoi rimanere con l'ordinamento "al volo" allora suggerisco di lavorare sull'evento WorksheetChange (e non SelectionChange), utilizzando questo codice:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Accett = "D11:D200" '<<< L'intervallo la cui modifica fa scattare l'ordinamento
Accett2 = "AB11:AB200" '<<< Idem secondo intervallo
If Target.Count > 1 Then Exit Sub
tval = Target.Value: tval1 = Target.Offset(0, 1).Value
If Not Application.Intersect(Range(Accett), Target.Cells(1, 1)) Is Nothing Then
LastD = Cells(Rows.Count, "D").End(xlUp).Row
With Range("D11:N" & LastD)
.Sort Key1:=Cells(6, "D"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
For Each cell In Range(Accett)
If cell.Value = tval And cell.Offset(0, 1) = tval1 Then
cell.Offset(0, 1).Select
Exit For
End If
Next cell
ElseIf Not Application.Intersect(Range(Accett2), Target.Cells(1, 1)) Is Nothing Then
LastD = Cells(Rows.Count, "AB").End(xlUp).Row
With Range("AB11:AN" & LastD) '<<< Le vere colonne
.Sort Key1:=Cells(6, "AB"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
For Each cell In Range(Accett)
If cell.Value = tval And cell.Offset(0, 1) = tval1 Then
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End If
End Sub
Ciao