copy copy row of data to empty row in sheet2

**shy07014** · 06-08-2008, 03:08 AM

hi there,
i need help with a bit of code:

i need a macro that searches columns C and E (on sheet1) for any cell with data.
and if finds data in either C or E, it copies that entire row to sheet2 in the next empty row, and adds a date stamp to column F

thanx in advance

**antoka05** · 06-08-2008, 04:41 AM

Try to use this macro:

Sub Macro1()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1LastRow As Long
    Dim sh2LastRow As Long
    Dim r As Long
    
    Set sh1 = ThisWorkbook.Sheets("sheet1")
    Set sh2 = ThisWorkbook.Sheets("sheet2")
    
    On Error Resume Next
    sh1LastRow = sh1.Cells.Find("*", SearchOrder:=xlByRows, _
                 SearchDirection:=xlPrevious).Row
    sh2LastRow = sh2.Cells.Find("*", SearchOrder:=xlByRows, _
                 SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    For r = 1 To sh1LastRow
        If sh1.Cells(r, "c") <> "" Or sh1.Cells(r, "e") <> "" Then
            sh2LastRow = sh2LastRow + 1
            sh1.Rows(r).Copy sh2.Cells(sh2LastRow, "a")
        End If
    Next
End Sub

Regards,
Antonio

**shy07014** · 06-08-2008, 05:18 AM

havnt tried yet, but code looks really good, only i dont see anywhere the code for the date stamp?

thanx shy

**VBA Noob** · 06-08-2008, 06:19 AM

shy07014,

Cross Post Please read forum rules below about cross posting

VBA Noob

**shy07014** · 06-08-2008, 01:21 PM

sorry, im new i didnt know, just read the rule, thanx for the info.

**antoka05** · 06-08-2008, 03:49 PM

I apologize but I forgot timestamp statement. Here is the new macro:

Sub Macro1()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1LastRow As Long
    Dim sh2LastRow As Long
    Dim r As Long
    
    Set sh1 = ThisWorkbook.Sheets("sheet1")
    Set sh2 = ThisWorkbook.Sheets("sheet2")
    
    On Error Resume Next
    sh1LastRow = sh1.Cells.Find("*", SearchOrder:=xlByRows, _
                 SearchDirection:=xlPrevious).Row
    sh2LastRow = sh2.Cells.Find("*", SearchOrder:=xlByRows, _
                 SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    For r = 1 To sh1LastRow
        If sh1.Cells(r, "c") <> "" Or sh1.Cells(r, "e") <> "" Then
            sh2LastRow = sh2LastRow + 1
            sh1.Rows(r).Copy sh2.Cells(sh2LastRow, "a")
            'here put timestamp on Sheet1
            'sh1.Cells(r, "f") = Format(Now, "mm/dd/yyyy hh:mm:ss")
            'here put timestamp on Sheet2
            sh2.Cells(sh2LastRow, "f") = Format(Now, "mm/dd/yyyy hh:mm:ss")
        End If
    Next
End Sub

Regards,
Antonio