Copy Paste with first column blank using macro

[HMN93]

Hi everyone,

I hope someone can help me with this.
I had to copy rows from one excel sheet to another if required condition is satisfied.
I have a set of rows containing many activities and each activity has a date and a code. What I need to do is to copy the rows that satisfies this condition: date=5/25/2014. Assume the following example in sheet 1:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Activity[/TD]
[TD]Date[/TD]
[TD]Code[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]5/25/2014[/TD]
[TD]12012[/TD]
[/TR]
[TR]
[TD]DS-120[/TD]
[TD]5/25/2014[/TD]
[TD]13016[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]5/25/2014[/TD]
[TD]14061[/TD]
[/TR]
[TR]
[TD]SD-130[/TD]
[TD]5/252014[/TD]
[TD]14061[/TD]
[/TR]
</tbody>[/TABLE]

Since all dates are equal to the condition then sheet2 (paste) must contain the four activities.
I wrote this code:

Dim i As Long, fdtae As Date, lastrow As Long
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
fdate = DateSerial(2014, 5, 25)
For i = 2 To lastrow
If Sheets("Sheet1").Cells(i, "B").Value = fdate Then
Sheets("Sheet1").Cells(i, "B").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

This code worked but had one problem. It did not copy the activities which have first column blank. It only copied and pasted the second and forth activities.

To solve this I tried adding a condition which is

If Sheets("Sheet1").Cells(i, "B").Value = fdate and Sheets("Sheet1").Cells(i, "A").Value="" Then

But it did not work.

Temporarily, I put an "a" in the blank cells and run the code and it did copy the four activities and then I removed the added "a". But when there are more than 100 activities, it is not a practical solution.

Can anyone help me solve this problem? How can I tell the code to read the row even if the first column does not contain data.

I really appreciate your help!

 

[Domenic]

Try...

Sheets("Sheet1").Cells(i, "B").EntireRow.Copy Destination:=Sheets("Sheet2").Range("[COLOR=#ff0000]B[/COLOR]" & Rows.Count).End(xlUp).[COLOR=#ff0000]Offset(1, -1)[/COLOR]

Although, here's another way that avoids looping and uses the AutoFilter...

Sub CopyData()

    Dim fdate As Date
    
    fdate = DateSerial(2014, 5, 25)

    With Sheets("Sheet2")
        NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With

    With Sheets("Sheet1")
        If .FilterMode Then .ShowAllData
        With .UsedRange
            .AutoFilter field:=2, Criteria1:=">=" & fdate, Operator:=xlAnd, Criteria2:="<=" & fdate
            .Offset(1, 0).Copy Sheets("Sheet2").Range("A" & NextRow)
            .AutoFilter
        End With
    End With
    
End Sub

Hope this helps!

 

[HMN93]

Thank you It worked

 

[Domenic]

You're very welcome, and thanks for the feedback!