Caro amigo, Alexandrevba, boa tarde. Mais uma vez peço lhe desculpas por minha demora.
A tua modificação ficou ótima. Fiz uma modificação de acordo com minha necessidade e ficou muito boa. E, isso devo a você.
Porém, se não for abuso peço a ti, por gentileza, mais uma ajuda.
Estou expondo o código modificado abaixo para faças uma avaliação e, se possível, me ajude.
Antes de tal exposição observe, por gentileza, minha necessidade.
Ao digitar na primeira coluna gostaria que o cursor pulasse para segunda coluna em seguida para terceira logo após para quarta coluna e ao chegar nessa quarta coluna voltasse para primeira coluna e cumprisse a sequencia de digitação mais uma vez dando seguimento na linha debaixo e assim por diante,
Por gentileza, poderia me ajudar mais uma vez?
Segue o código modificado.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LLoop As Integer
Dim LTargetRange1 As String
Dim LDestRange1 As String
Dim LTargetRange2 As String
Dim LDestRange2 As String
Dim LTargetRange3 As String
Dim LDestRange3 As String
Dim yourdate1 As String
Dim yourdate2 As String
Dim yourdate3 As String
Dim lngLastRow As Long
yourdate1 = Format(Date, "dd")
yourdate2 = Format(Date, "mmmm")
yourdate3 = Format(Date, "yyyy")
lngLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
LLoop = 2
While LLoop <= lngLastRow
'Link coluna A to B
LTargetRange1 = "A" & CStr(LLoop)
LDestRange1 = "e" & CStr(LLoop)
LTargetRange2 = "A" & CStr(LLoop)
LDestRange2 = "f" & CStr(LLoop)
LTargetRange3 = "A" & CStr(LLoop)
LDestRange3 = "g" & CStr(LLoop)
If Not Intersect(Range(LTargetRange1), Target) Is Nothing Then
If Len(Range(LTargetRange1).Value) > 0 Then
Range(LDestRange1).Value = yourdate1
Else
Range(LDestRange1).Value = Null
End If
End If
If Not Intersect(Range(LTargetRange2), Target) Is Nothing Then
If Len(Range(LTargetRange2).Value) > 0 Then
Range(LDestRange2).Value = yourdate2
Else
Range(LDestRange2).Value = Null
End If
End If
If Not Intersect(Range(LTargetRange3), Target) Is Nothing Then
If Len(Range(LTargetRange3).Value) > 0 Then
Range(LDestRange3).Value = yourdate3
Else
Range(LDestRange3).Value = Null
End If
End If
LLoop = LLoop + 1
Wend
End Sub
Grato mais uma vez.
PAYZZANNO.
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 09/03/2013 10:50 am