Macro to copy and paste cells on multiple sheets based on dates

Hi All,

I currently am running a spreadsheet with hundreds of sheets each representing an agreement.

These sheets contain all instalments, past current and future.

Every month I copy the last month's instalment, paste it to the cell below it (next months) and then run a goal seek to distribute the differences in interest calculation amongst the remaining instalments.

Up till now I copy-paste on every sheet manually and this is what I have created to make my life easier after I have done that:

Sub GoalSeek_NxtSheet()
'
' GoalSeek_NxtSheet Macro
'
' Keyboard Shortcut: Ctrl+r
'
    Range("E75").GoalSeek Goal:=0, ChangingCell:=Range("D12")
    ActiveSheet.Next.Select
End Sub

Is there a way to create a macro that will search for a date (say "2013/07/25") in column "A" then copy the cell to its left and paste it one cell below?

The rest would be simply to add what I already have in the macro to do the goal seeking until the macro reaches the last sheet...

Example:
Example snippet.PNG

Thank you in advance :-)

Sub amened()
Application.ScreenUpdating = 0
Dim rFind As Range, sAddr$, Searchfor As Date

Searchfor = "2013/07/25"

                   With ActiveSheet.Range("A:A")
                     Set rFind = .Find(CDate(Searchfor), .Cells(.Cells.Count), xlValues, xlWhole)
                        If Not rFind Is Nothing Then
                            sAddr = rFind.Address
                            Do
            
                             rFind.Offset(, 1).Copy rFind.Offset(1)
                         
                            Loop While rFind.Address <> sAddr
                           
                            sAddr = ""
                        End If
                   End With
        
Application.ScreenUpdating = True
End Sub

Originally Posted by AB33

Sub amened()
Application.ScreenUpdating = 0
Dim rFind As Range, sAddr$, Searchfor As Date

Searchfor = "2013/07/25"

                   With ActiveSheet.Range("A:A")
                     Set rFind = .Find(CDate(Searchfor), .Cells(.Cells.Count), xlValues, xlWhole)
                        If Not rFind Is Nothing Then
                            sAddr = rFind.Address
                            Do
            
                             rFind.Offset(, 1).Copy rFind.Offset(1)
                         
                            Loop While rFind.Address <> sAddr
                           
                            sAddr = ""
                        End If
                   End With
        
Application.ScreenUpdating = True
End Sub

Thanks AB33 for your reply.

However the data is being copied to the wrong cell - as I am not familiar with this language I refrain from trying to edit your code myself.

Here is a snapshot of what happened when running your code:
Error snippet.PNG

Thanks for your help so far! :-)

Please do not reply with quote, just a reply will do.

If you are searching column A, you can not go to the left of column as there is none.
My code goes to the right.
If the code finds, let say in A2, one to the right of A2 is B2 and where do you want to copy B2 in to?

Apologies, I meant to the right.

If it is found in A2 then I need B2 to be copied to B3.

If you look at my snapshot your macro is copying it to A3 (in the above scenario).

Sub amened()
Application.ScreenUpdating = 0
Dim rFind As Range, sAddr$, Searchfor As Date

Searchfor = "2013/07/25"

                   With ActiveSheet.Range("A:A")
                     Set rFind = .Find(CDate(Searchfor), .Cells(.Cells.Count), xlValues, xlWhole)
                        If Not rFind Is Nothing Then
                            sAddr = rFind.Address
                            Do
            
                             rFind.Offset(, 1).Copy rFind.Offset(, 2)
                             Set rFind = .FindNext(rFind)
                            Loop While rFind.Address <> sAddr
                           
                            sAddr = ""
                        End If
                   End With
        
Application.ScreenUpdating = True
End Sub

Hey,

So now it's copying the cell to right of the found date to one column right.

For example if the date is found in cell A2 then B2 is copied to C2.

Error snippet 2.PNG

Sorry,
I can not get my coordinator right
Change this line of the code

rFind.Offset(, 1).Copy rFind.Offset(, 2)

INTO

 rFind.Offset(, 1).Copy rFind.Offset(1, 1)

Perfect! works like a charm :-)

now how can I put this in a while loop with a command to go to the next sheet till its reached the last sheet in the workbook?

Do you mean you want to apply it across sheets, instead of a single sheet as it does now?

Yes, that is correct.

"Runtime error '438'
Object does not support this property or method"

When debugging it highlights "rFind.Offset(, 1).Copy .rFind.Offset(1, 1)"

Yes, I have corrected it. Look at the code again.

Can I add a Goal Seek option that will be done per sheet that the date is found as follows:

Do
   rFind.Offset(, 1).Copy rFind.Offset(1, 1)
   Set rFind = .FindNext(rFind)
   Range("E75").GoalSeek Goal:=0, ChangingCell:=Range("D12")
   Loop While rFind.Address <> sAddr