VBA code not copying all data in row to another worksheet

[ExcelGirl1988]

Hi,

I have been working on this code for a while and I have finally figured most of it out but some of it still is not working how I need it to. The code is going to be used to search for a date (input by the user) across all worksheets and then the data in that row will be copied onto the summary worksheet but I cannot figure out how to get all the row copied over, only the first 2 cells are copied, not all cells with data in the row.

The code I am using is:

Sub ExtractDataBasedOnDate()


Dim LastRow As Long, erow As Long, i As Long
Dim myDate As Date, StartDate As Date, EndDate As Date
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet


Application.ScreenUpdating = False


LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row


StartDate = Sheets("Home").Range("D3").Value
EndDate = Sheets("Home").Range("D4").Value


For Each ws In ThisWorkbook.Worksheets
 If ws.Name <> "Summary" Then
    ws.Activate
    Application.CutCopyMode = False
        For i = 2 To LastRow
            myDate = Cells(i, 2)
            If myDate >= StartDate And myDate <= EndDate Then
                erow = Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                Range(Cells(i, 1), Cells(i, 2)).Copy Destination:=Sheets("Summary").Cells(erow, 1)
                Application.CutCopyMode = False
            End If
        Next i
 End If
Next ws
 
starting_ws.Activate


Application.ScreenUpdating = True


End Sub

I think the troublesome part of the code is:

Range(Cells(i, 1), Cells(i, 2)).Copy

Could anyone offer any suggestions? Thank you

 

[njimack]

Try this (untested):

If myDate >= StartDate And myDate <= EndDate Then
    erow = Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    lastcol = Cells(erow, Columns.Count).End(xlToLeft).Column
    Range(Cells(i, 1), Cells(i, lastcol)).Copy Sheets("Summary").Cells(erow, 1)

 

[ExcelGirl1988]

That worked!! Thank you so much

 

[ExcelGirl1988]

I've run into another problem the code finds and copies all data from the first worksheet it searches but then when it gets the data from the other worksheets it only copies the first cells, not all three. I think the problem is with this line of code:

LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

Do you have any suggestions on this? Thank you

 

[dmt32]

I've run into another problem the code finds and copies all data from the first worksheet it searches but then when it gets the data from the other worksheets it only copies the first cells, not all three. I think the problem is with this line of code:

LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

Do you have any suggestions on this? Thank you

Untested but see if this update to your code helps

Sub ExtractDataBasedOnDate()
    
    Dim erow As Long, i As Long
    Dim myDate As Date, StartDate As Date, EndDate As Date
    Dim ws As Worksheet, wsSummary As Worksheet
    
    
    Set wsSummary = ThisWorkbook.Worksheets("Summary")
    
    Application.ScreenUpdating = False
    
    With Worksheets("Home")
        StartDate = .Range("D3").Value
        EndDate = .Range("D4").Value
    End With
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                myDate = ws.Cells(i, 2)
                If myDate >= StartDate And myDate <= EndDate Then
                    erow = wsSummary.Cells(wsSummary.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    ws.Cells(i, 1).Resize(i, ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column).Copy _
                    Destination:=wsSummary.Cells(erow, 1)
                    Application.CutCopyMode = False
                End If
            Next i
        End If
    Next ws
            
    Application.ScreenUpdating = True
               
End Sub

Dave

 

[ExcelGirl1988]

Thank you for this Dave, this works quite well but it duplicates a few of the records, is there a workaround for this?

Thank you

 

[dmt32]

Thank you for this Dave, this works quite well but it duplicates a few of the records, is there a workaround for this?

Thank you

Tad difficult to say without seeing your data - did the earlier suggested update to your code copy ok with creating duplicate records?

Dave

 

[njimack]

It's because you're setting LastRow once (at the start of your code). You don't actually need it at all, simply change the copy/paste line to this (again, untested):

Range(Cells(i, 1), Cells(i, lastcol)).Copy Destination:=Sheets("Summary").Cells(Rows.Count.End(xlUp).Offset(1), 1)

 

[ExcelGirl1988]

Thank you everyone for your help, my code works now and does what I need it to do