Transferência de dados entre pastas, criando um histórico

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Autor: Eneias dos Santos Pedroso
'
For Each Item In Target
If Target.Row = 1 Then Exit Sub
If Target.Column = 1 Then
For j = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(j + 1, 1) = "" Then
Worksheets(1).Cells(j + 1, 1) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next j: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 2 Then
For k = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(k + 1, 2) = "" Then
Worksheets(1).Cells(k + 1, 2) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next k: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 3 Then
For m = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(m + 1, 3) = "" Then
Worksheets(1).Cells(m + 1, 3) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next m: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 4 Then
For n = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(n + 1, 4) = "" Then
Worksheets(1).Cells(n + 1, 4) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next n: End If
Next Item
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Mudar informação em célula diariamente (+1)

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Activate()
'
'Autor: Eneias dos Santos Pedroso
'
Dim MyDate
MyDate = #5/7/2005#
'Lembre-se, o formato aqui é mês, dia e ano.
'Para nossa compreensão, 07/05/2005
'Também o valor de MyDate poderia ser uma célula - exemplo:
'MyDate = [E1]
'Nessa célula coloque a data com o formato usual
[A1] = MyDate - Date
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !