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;
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;
VBA Code:
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