[vba] Add timestamp to LastRow

[zeromax1]

Hi all, I write an VBA that need to copy a filtered data from sheet a to sheet b, I want to add the timestamp to the right column on sheet b. However, the vba only add 1row time stamp for each paste action. The timestamp cannot past till to the last row.

Below are part of my VBA code

Sub Transpose()

Dim whs, whs2 As Worksheet
Dim lastrow2, lastrow3 As Long
Dim i As Integer


Set whs = ThisWorkbook.Worksheets("sheet1")
Set whs2 = ThisWorkbook.Worksheets("sheet2")

lastrow2 = whs2.Range("D" & whs2.Rows.Count).End(xlUp).Row
lastrow3 = wrs.Range("B" & wrs.Rows.Count).End(xlUp).Row


    whs.Activate
    
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
    wrs.Range("J6").AutoFilter field:=10, Criteria1:="<>", Operator:=xlFilterValues
    
    wrs.Range("B7:C" & lastrow3 & "," & "I7:K" & lastrow3).SpecialCells(xlCellTypeVisible).Copy Destination:=rcod.Cells(lastrow2 + 1, 4)

    For i = 2 To Lastrow
   
    If rcod.Cells(i, "D").Value <> "" And rcod.Cells(i, "E").Value <> "" And rcod.Cells(i, "F").Value <> "" And rcod.Cells(i, "G").Value <> "" And rcod.Cells(i, "H").Value <> "" Then
    
    rcod.Cells(i + 1, "I").Value = Date
    rcod.Cells(i + 1, "I").NumberFormat = "mm/dd/yy"
    
    End If
    
    Next i

    Application.CutCopyMode = False
      

End Sub

How can I fill the timestamp to each row when I copy the visible data from sheet A to sheet B? Many Thanks.

 

[offthelip]

I think your problem is that LASTROW is not set to anything. I think you need something like

LastRow = rcod.Cells(Rows.Count, "A").End(xlUp).Row - lastrow2

however I am not sure what you are trying to do.

 

[zeromax1]

I think your problem is that LASTROW is not set to anything. I think you need something like

LastRow = rcod.Cells(Rows.Count, "A").End(xlUp).Row - lastrow2

however I am not sure what you are trying to do.

I only rewrite for the truth information. I still got one time stamp only.

Sub Transpose()

Dim whs, whs2 As Worksheet
Dim lastrow2, lastrow3 As Long
Dim i As Integer


Set whs = ThisWorkbook.Worksheets("sheet1")
Set whs2 = ThisWorkbook.Worksheets("sheet2")

lastrow2 = whs2.Range("D" & whs2.Rows.Count).End(xlUp).Row
lastrow3 = wrs.Range("B" & wrs.Rows.Count).End(xlUp).Row


    whs.Activate
    
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
    wrs.Range("J6").AutoFilter field:=10, Criteria1:="<>", Operator:=xlFilterValues
    
    wrs.Range("B7:C" & lastrow3 & "," & "I7:K" & lastrow3).SpecialCells(xlCellTypeVisible).Copy Destination:=wrs2.Cells(lastrow2 + 1, 4)

    For i = 2 To Lastrow
   
    If wrs2.Cells(i, "D").Value <> "" And wrs2.Cells(i, "E").Value <> "" And wrs2.Cells(i, "F").Value <> "" And wrs2.Cells(i, "G").Value <> "" And wrs2.Cells(i, "H").Value <> "" Then
    
    wrs2.Cells(i + 1, "I").Value = Date
    wrs2.Cells(i + 1, "I").NumberFormat = "mm/dd/yy"
    
    End If
    
    Next i

    Application.CutCopyMode = False
      

End Sub

 

[offthelip]

Yes because you still haven't set lastrow to anything!! You have got lastrow2 and lastrow3 but NOT lastrow
this is the line that has got the problem:

For i = 2 To Lastrow