nel Private Sub Worksheet_Change(ByVal Target As Range) del precedente thread:
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110402
volevo aggiungere per i valori del range E12:E4039 questa possibilità.
In pratica al momento devo digitare il valore "op" per ogni cella mentre vorrei che quando digito un valore in questa colonna dopo una o più celle vuote, lo script prenda il numero precedente e lo scriva se la cella adiacente (range D12:D4039) non è vuota.
Nello specifico: digitando 11 (in E21) il dato atteso è la compilazione con il numero 23 (quello precedente) solamente delle celle E13-E15-E17 (quelle che nella prima parte dello script sono state compilate e "congelate").
E precisamente:
Con tanto aiuto è questo lo script partorito:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Rng2 As Range
Dim rArea As Range
Dim vVal As Variant
On Error GoTo XIT
Application.EnableEvents = False
Set Rng = Me.Range("D12:E4039")
If Not Intersect(Target, Rng.Columns(1)) Is Nothing _
And Target.Count = 1 Then
With Target
If .Offset(0, 7).Value = "" Then
.Offset(0, 7).Value = Now
.Offset(0, 7).NumberFormat = "dd/mm/yyyy hh:mm:ss"
End If
End With
ElseIf Not Intersect(Target, Rng.Columns(2)) Is Nothing Then 'Rng.Columns(2)
With Rng.Columns(2) 'Rng.Columns(2)
On Error Resume Next
Set Rng2 = .Resize(Target.Row - .Row). _
SpecialCells(xlCellTypeBlanks)
On Error GoTo XIT
If Not Rng2 Is Nothing Then
For Each rArea In Rng2.Areas 'Rng2.Areas
With rArea
vVal = .Cells(1).Offset(.Cells.Count).Value '.Cells(1)
If Not vVal = vbNullString Then
.Value = vVal
End If
End With
Next rArea
End If
End With
End If
XIT:
Application.EnableEvents = True
End Sub
Ed ottengo:
1) che il numero riportato è l'ultimo digitato e non il precedente,
2) che il dato è scritto in tutte le celle vuote tra i due valori,
3) dulcis in fundo.....che se cancello il valore in E13 (solo per questa cella!!) mi compila le celle K1:K11 con data e orario -????
Sono impallato da qualche giorno.
https://www.dropbox.com/s/2cie6xg2qsvop3y/copia%20valore%20v2.xlsm?dl=0
E anticipatamente ringrazio per l'eventuale aiuto.