Copy cell values from one workbook to another is suddenly not working.

[XrayLemi]

Hello all,
The code I have listed here is suddenly out of the blue giving me a problem. It is a module that activates when a particular criteria is met on a worksheet. It has worked fine for more than a year. But with no changes to this code, it has stopped working correctly. The part of the code that suddenly is not working, is the copy and paste portion. Everything else works fine. The destination file opens, The e-mail gets sent, the destination file gets saved, but yet nothing copies to the destination file. Here is the code.

Sub Copyemail()
    Application.ScreenUpdating = False
    Workbooks.Open "S:\Radiology\LOG BOOKS\Not Approved List.xlsm"
    Workbooks("Not Approved List.xlsm").Sheets("Sheet1").Unprotect Password:="Password"
       Dim wsCopy As Worksheet
       Dim wsDest As Worksheet
       Dim lCopyLastRow As Long
       Dim lDestLastRow As Long
       Set wsCopy = Workbooks("General-12-28-21").ActiveSheet
       Set wsDest = Workbooks("Not Approved List.xlsm").Worksheets("Sheet1")
       lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "H").End(xlUp).Row
       lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
       wsDest.Range("A" & lDestLastRow).Value = wsCopy.Range("H" & lCopyLastRow).Value
       wsCopy.Range("H" & lCopyLastRow).Copy wsDest.Range("A" & lDestLastRow)
       wsDest.Range("B" & lDestLastRow).Value = lCopyLastRow
       wsDest.Range("C" & lDestLastRow).Value = wsCopy.Parent.Name
       wsDest.Range("D" & lDestLastRow).Value = Date
       wsDest.Activate
     Workbooks("Not Approved List.xlsm").Close SaveChanges:=True
   Dim outlookApp As Object
   Dim myMail As Object
   Set outlookApp = CreateObject("Outlook.Application")
   Set myMail = outlookApp.CreateItem(0)
   myMail.to = "Me@Place.net"
   myMail.Subject = "Not on the Approved List"
   myMail.HTMLBody = "Additions have been made to the Not Approved List file"
   myMail.send
 End Sub

Thank you in advance,
Jim

 

[XrayLemi]

Okay,
Turns out the problem is with hidden rows. For example, if row 79 is filled out, but is hidden, The code I have will not let an entry go in to row 80 (the next free row) If I unhide row 79, the code works as it should. Is there a way to get the copied data to the sheet if the row above is hidden?

 

[MARK858]

Try replacing

lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

with

lDestLastRow = wsDest.Columns(1).Find("*", , xlFormulas, , xlByRows, xlPrevious).Offset(1).Row

If you don't have any formulas in column A returning ""

 

[XrayLemi]

Seems to work perfectly!
Thank you so much!

 

[MARK858]

You're welcome