Macro to copy and replace based on dates

I want a macro that will compare two different sheets. In both sheets column B will contain dates. I want the macro to look at sheet1 at the last row of data in column B and add 1 day. I then want it to go to sheet2 and look for this date and when it finds it copy all the data from then downwards to sheet1 at the very bottom.

Trying desperately to find a solution online but have come up blank! Anyone any knowledge of how i would do/start this?

Here you go.

sample.xlsm

So in the sample I've uploaded in Sheet1, look at the last row of data in column B and add 1 day to the date that you find. Then go to sheet2 and search for this date and when it finds the first instance of this date copy everything on that row and below it and paste it below the last used row in sheet1.

What about this workaround? Find the last date used in column B sheet 1 and add one day and paste the value in a random cell and then search for the date in the cell in sheet 2 and when found copy and paste that row and everything below to the bottom of sheet 1?

I've managed to come up with this which finds the last date in column B sheet 1 and pastes the value into sheet2.

Sub SelectLastCellInColumnOptionB()

Dim Rws As Long, Rng As Range

Rws = Cells(Rows.Count, "B").End(xlUp).Row

Cells(Rws, 2).Copy

Sheets("Sheet2").Select
Range("W1").Select
ActiveSheet.Paste


End Sub

I now want code that will Find the date in sheet2 which is now in cell W1 in sheet 2 and when it finds it copy that row and all rows below it that are in use.

Have gotten this far with the following but doesn't work although I think I'm on the right tracks. Any help fixing the below code??

Sub testtttttt()

    Dim FindWord As String, Found As Range
    Dim wsDest As Worksheet, ws As Worksheet, wb As Workbook
    Dim Nextrow As Long, Lastrow As Long

    Set wsDest = ThisWorkbook.Sheets("Sheet1")
    FindWord = ThisWorkbook.Sheets("Sheet2").Range("W1").Value 'I want to find the date that will be in W1
    
    Application.ScreenUpdating = False
 
             With ThisWorkbook.Worksheets("Sheet2")
             Set Found = ws.Range("B:B").Find(What:=FindWord, _
                                                 LookIn:=xlValues, _
                                                 LookAt:=xlPart, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlNext, _
                                                 MatchCase:=False)

                If Not Found Is Nothing Then
                    Nextrow = wsDest.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1 ' Next empty row on Sheet1
                    Lastrow = ws.Cells.Find("*", , , , xlByRows, xlPrevious).Row         ' Last used row on sheet2
                    ' Copy\Paste found sheet2 data to the next empty row on Sheet1
                    ws.Range(Found, Found.End(xlToRight)).Resize(Lastrow - Found.Row + 1).Copy _
                        Destination:=wsDest.Range("B" & Nextrow)
                End If
       
    Application.ScreenUpdating = True
    
End With
End Sub

   Set Found = ws.Range("B:B").Find(What:=FindWord, _
                                                 LookIn:=xlValues, _
                                                 LookAt:=xlPart, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlNext, _
                                                 MatchCase:=False)

The above is causing the issue here with error message Object variable or With block variable not set.

The code below runs through and gives me the message box but doesn't paste everything below where it finds value W2 into the bottom of sheet1. Why?!?! I'm going crazy trying to work this one out!!!!!!!!!!

Sub test222()
Dim FindWord As String, Found As Range
    Dim wsDest As Worksheet, ws As Worksheet, wb As Workbook
    Dim Nextrow As Long, Lastrow As Long
     
    Set ws = ThisWorkbook.Sheets("Sheet2")
    Set wsDest = ThisWorkbook.Sheets("Sheet1")
    
FindWord = ThisWorkbook.Sheets("Sheet1").Range("W2").Value

Set Found = ws.Range("B:B").Cells.Find(What:=FindWord, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
 
If Not Found Is Nothing Then
                    Nextrow = wsDest.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1 ' Next empty row on Sheet1
                    Lastrow = ws.Cells.Find("*", , , , xlByRows, xlPrevious).Row         ' Last used row on sheet2
                    ' Copy\Paste found sheet2 data to the next empty row on Sheet1
                    ws.Range(Found, Found.End(xlToRight)).Resize(Lastrow - Found.Row + 1).Copy _
                        Destination:=wsDest.Range("B" & Nextrow)
                End If
   
    Application.ScreenUpdating = True
    MsgBox "Copy complete.", vbInformation, "Copy Data"

End Sub

http://www.mrexcel.com/forum/excel-q...find-copy.html

The above link has the same issue with the most recent code that needs fixing so my macro will work

sample.xlsm

This might make it simpler. Attached is a workbook with sheet1 and sheet2 and how sheet1 is supposed to look after the macro is run. The added data after the macro is run is in red font.