VBA Code to loop through Tabs in Excel WorkBook and Paste data in different Book

[Kristylee0228]

I am looking for VBA Code to loop through tabs in an Excel WorkBook named with dates of the week.
Copy and Paste data in row 3 and down to the last filled cell into a new Workbook.

What I want is for the code to start on the "Active Sheet" and loop through the last sheet.
The WorkBook is updated Daily with data through the previous week.
I would be running the Macro on Monday's to grab last week data.
Unless there is an easier way to do this, I will have the WorkBook saved on the Active Sheet so that we don't copy & paste data we already have. (from previous weeks)

Any help is greatly appreciated.

Here is a screenshot of Tab Names.

 

[Skyybot]

Set DestWs = Workbooks(SfilePath).Sheets("Exceptions " & Replace(sDate, "/", "-") & " to " & Replace(eDate, "/", "-")).Activate

 

[Kristylee0228]

Thank you generously for the help! I've got this part of the Macro working and am now at a Syntax error.
Where I want the Macro to go through the Tabs of the SourceWb to Start at Row 2 of each worksheet as not to include the Header row and copy through to the next filled cell. (But not include it anything below it.)
I have a Start Date and End Date to look at the 2nd column of the Source WB and only copy and paste according to those dates.
Here's the full Macro Code:

Sub DailyExceptions()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Dim sDate As String, eDate As String
sDate = InputBox("Please enter a start date. Format(m/dd/yy)")
eDate = InputBox("Please enter an end date. Format(m/dd/yy)")

Dim SourceWb As Workbook
Dim SourceWs As Worksheet
Dim WsName As String
Dim EndRow As Long
Dim FirstBlankRow As Long
Dim DestWb As Workbook
Dim DestWs As Worksheet

Set SourceWb = Workbooks.Open("\\ncbanalytics\Automation\QA_Compliance\Daily Exceptions Report- August 2023.xlsx", , True)
'Set SourceWb = Workbooks.Open("\\ncb-fs1\RDAudit\Daily Exceptions\August 2023\Daily Exceptions Report- August 2023.xlsx", , True)
Rows("2:2").Select
Selection.Copy
Range("A1").Select

Set DestWb = Workbooks.Open("\\ncb-fs1\Compliance-QA\Exception Reporting\Weekly Exception Summaries (Heather)\TestReview from " & Replace(sDate, "/", "-") & " thru " & Replace(eDate, "/", "-") & ".xlsx", , False)
With ActiveSheet
Rows("1:1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End With
Application.CutCopyMode = False

On Error Resume Next
For Each SourceWs In SourceWb.Worksheets
EndRow = SourceWs.Range("A1").CurrentRegion.Rows.Count
For i = 2 To EndRow 'start copy at row2 so not to include HeaderRow
""This is where I have the syntax error.""
If SourceWs.Cells(i,2) <= sdate and >= edate Then
FirstBlankRow = DestWb.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceWs.Rows(i).Copy Destination:=DestWb.Rows(FirstBlankRow)
End If
Next i
Next SourceWs

SourceWb.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

 

[Skyybot]

I'm going to check this out. Going forward, would you please put your code in VBA format? It makes it easier to read. i.e.:

Sub DailyExceptions()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

 

[Skyybot]

Thank you generously for the help! I've got this part of the Macro working and am now at a Syntax error.
Where I want the Macro to go through the Tabs of the SourceWb to Start at Row 2 of each worksheet as not to include the Header row and copy through to the next filled cell. (But not include it anything below it.)
I have a Start Date and End Date to look at the 2nd column of the Source WB and only copy and paste according to those dates.
Here's the full Macro Code:

Sub DailyExceptions()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Dim sDate As String, eDate As String
sDate = InputBox("Please enter a start date. Format(m/dd/yy)")
eDate = InputBox("Please enter an end date. Format(m/dd/yy)")

Dim SourceWb As Workbook
Dim SourceWs As Worksheet
Dim WsName As String
Dim EndRow As Long
Dim FirstBlankRow As Long
Dim DestWb As Workbook
Dim DestWs As Worksheet

Set SourceWb = Workbooks.Open("\\ncbanalytics\Automation\QA_Compliance\Daily Exceptions Report- August 2023.xlsx", , True)
'Set SourceWb = Workbooks.Open("\\ncb-fs1\RDAudit\Daily Exceptions\August 2023\Daily Exceptions Report- August 2023.xlsx", , True)
Rows("2:2").Select
Selection.Copy
Range("A1").Select

Set DestWb = Workbooks.Open("\\ncb-fs1\Compliance-QA\Exception Reporting\Weekly Exception Summaries (Heather)\TestReview from " & Replace(sDate, "/", "-") & " thru " & Replace(eDate, "/", "-") & ".xlsx", , False)
With ActiveSheet
Rows("1:1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End With
Application.CutCopyMode = False

On Error Resume Next
For Each SourceWs In SourceWb.Worksheets
EndRow = SourceWs.Range("A1").CurrentRegion.Rows.Count
For i = 2 To EndRow 'start copy at row2 so not to include HeaderRow
""This is where I have the syntax error.""
If SourceWs.Cells(i,2) <= sdate and >= edate Then
FirstBlankRow = DestWb.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceWs.Rows(i).Copy Destination:=DestWb.Rows(FirstBlankRow)
End If
Next i
Next SourceWs

SourceWb.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Make sure that Cells(i,2) is formatted as Date.

 

[Skyybot]

Make sure that Cells(i,2) is formatted as Date.

Or try Cells(i,2).Value

 

[kevin9999]

""This is where I have the syntax error.""
If SourceWs.Cells(i,2) <= sdate and >= edate Then

Change to:

If SourceWs.Cells(i, 2) <= sdate And SourceWs.Cells(i, 2) >= edate Then

though I strongly recommend you don't use native Excel function names (edate) as variable names.