Transfer data from sheets to workbook if date is before today

[DanSMT]

Hi all,

Having an issue with the VBA code here. I'm trying to transfer the last line of all sheets "if the date in column is is < today's date" to a new workbook and then generate a email to send this generated file out. Currently it is pulling from the first sheet, although when I add a sheet it just pulls from the first sheet 2 times.

VBA code below;

Sub SuperCB_Click()
'Search last row last row in all sheets
Dim WSheet As Worksheet
Dim lastRow As Long
Dim oWbLog As Workbook
Dim oWsDue As Worksheet
Dim iStatus As Long
Application.ScreenUpdating = False

  Dim Found As Boolean
  Dim InxWbk As Long
  Dim MasterList As Workbook

  Found = False
  For InxWbk = 1 To Workbooks.Count
    If Workbooks(InxWbk).Name = "Book1.xlsm" Then
      Set MasterList = Workbooks(InxWbk)
      Found = True
      Exit For
    End If
  Next

  If Not Found Then
    Set MasterList = Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsm")
  End If

Set oWsDue = Workbooks.Add.Sheets(1)
    Application.DisplayAlerts = False
    oWsDue.Parent.SaveAs ("c:\users\dans\desktop\torque system\Due.xls")
    Application.DisplayAlerts = True
  
Workbooks("Book1.xlsm").Activate

    For Each WSheet In Worksheets
    
    With WSheet
        
        lastRow = .Range("A" & Rows.Count).End(xlUp).row
      
            If .Range("J" & lastRow).Value = "<>" Then
            
            ElseIf .Range("A" & lastRow).Value < Date Then
    
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lastCol As Long
Dim lDestLastRow As Long

  Set wsCopy = Workbooks("book1.xlsm").ActiveSheet
  Set wsDest = Workbooks("due.xls").Worksheets("sheet1")

    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).row

    lastCol = wsCopy.Cells(2, wsCopy.Columns.Count).End(xlToLeft).Column

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

With wsCopy
    .Range(.Cells(1, 1), .Cells(lCopyLastRow, lastCol)).Copy wsDest.Range("A" & lDestLastRow)
End With
            End If
End With
    Next WSheet
End Sub

 

[JLGWhiz]

I think if you change this

 Set wsCopy = Workbooks("book1.xlsm").ActiveSheet

to this

 Set wsCopy = WSheet

it would fix the problem. The loop does not change the ActiveSheet even though the value of WSheet changes on each iteration. So whatever sheet was active when you switched to book1.xlsm is the one it will use for wsCopy variable as the code is now written.

Just a suggestion: Don't over use variables. The same variable can be used throughout the code to do different chores in most cases.