Transfer data from sheets to workbook if date is before today

DanSMT

Board Regular
Joined
Sep 13, 2019
Messages
72
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;

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
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I think if you change this
VBA Code:
 Set wsCopy = Workbooks("book1.xlsm").ActiveSheet
to this
VBA Code:
 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.
 
Last edited:
Solution

Watch MrExcel Video

Forum statistics

Threads
1,123,206
Messages
5,600,317
Members
414,376
Latest member
NickYOW

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top