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]

Copy fist Column only, or are there multiple Columns? Will the data be copied into the same Workbook every time, or will there be a different Workbook for every save? What should the New Workbook be named?

 

[Kristylee0228]

I would be copying Columns A through J, rows 3 to the last filled cell. It's going to be copied into the same WorkBook daily throughout the Month.
At the start of the new month, I will create a new workbook and change the name within the Macro.
The Save Name is "Review from m-dd-yy thru m-dd-yy" (date range will be selected. The Tab within the Workbook would be named "Exceptions m-dd-yy - m-dd-yy" (the same date range.)

 

[Skyybot]

I've run into an issue when it comes to Sheets that have multiple dates on them. i.e. - July 21-23, 2023. Would it be possible to have one Sheet per date?

 

[Kristylee0228]

I've run into an issue when it comes to Sheets that have multiple dates on them. i.e. - July 21-23, 2023. Would it be possible to have one Sheet per date?

Absolutely. I can have the team that sends me the spreadsheet separate the weekend.

 

[Kristylee0228]

Still looking for an answer. I have made some progression on this. Below is the Code I have. I am getting Compile error: Object Required. and I do not know what I am missing.

Sub DailyExceptions()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

Dim sDate As String, eDate As String, SfilePath As String

sDate = InputBox("Please enter a start date. Format(m/dd/yy)")

eDate = InputBox("Please enter an end date. Format(m/dd/yy)")


SfilePath = "\\ncb-fs1\Compliance-QA\Exception Reporting\Weekly Exception Summaries (Heather)\Review from " & Replace(sDate, "/", "-") & " thru " & Replace(eDate, "/", "-") & ".xlsx"

SfilePath = ActiveWorkbook.Name

Dim SourceWb As Workbook

Dim SourceWs As Worksheet

Dim WsName As String

Dim EndRow As Long

Dim FirstBlankRow As Long

Dim DestWb As String


Set SourceWb = Workbooks.Open("\\ncbanalytics\Automation\QA_Compliance\Daily Exceptions Report- August 2023.xlsx", , True)

Range("A2:K2").Select

Selection.Copy

Everything works up to this point.

This is where I get the error.

Set DestWb = SfilePath

Range("A1").Select

Selection.Paste

 

[Skyybot]

SfilePath is dimensioned as String. Remove the Set statement. DestWb = SfilePath

 

[Kristylee0228]

That worked. Thank you!
I am at the part where the code opens my workbook and copies the row I need.
I am getting a "Script Out of Range" error when trying to set the Active Sheet as DestWs.

Sub DailyExceptions()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False


Dim sDate As String, eDate As String, SfilePath As String

sDate = InputBox("Please enter a start date. Format(m/dd/yy)")

eDate = InputBox("Please enter an end date. Format(m/dd/yy)")

SfilePath = "\\ncb-fs1\Compliance-QA\Exception Reporting\Weekly Exception Summaries (Heather)\Review from " & Replace(sDate, "/", "-") & " thru " & Replace(eDate, "/", "-") & ".xlsx"

Application.DisplayAlerts = False

SfilePath = ActiveWorkbook.Name

Dim SourceWb As Workbook

Dim SourceWs As Worksheet

Dim WsName As String

Dim EndRow As Long

Dim FirstBlankRow As Long

Dim DestWb As String

Dim DestWs As Worksheet


Set SourceWb = Workbooks.Open("\\ncbanalytics\Automation\QA_Compliance\Daily Exceptions Report- August 2023.xlsx", , True)

Rows("2:2").Select

Selection.Copy

SfilePath = ActiveWorkbook.Name

"Script Out of Range" Errors here
Set DestWs = Sheets("Exceptions " & Replace(sDate, "/", "-") & " to " & Replace(eDate, "/", "-")).Activate

With ActiveSheet

Rows("1:1").Select

ActiveSheet.Paste

Cells.Select

Cells.EntireColumn.AutoFit

Range("A1").Select

End With

Application.ScreenUpdating = True

Application.DisplayAlerts = True

Application.EnableEvents = True

End Sub

 

[Skyybot]

You need to further define the Sheet location if multiple Workbooks are open. Replace WorkbookName with the name of your Workbook
Set DestWs = Workbooks("WorkbookName").Sheets("Exceptions " & Replace(sDate, "/", "-") & " to " & Replace(eDate, "/", "-")).Activate

 

[Kristylee0228]

I changed "WorkbookName" to SfilePath and ran it. Still errors Script Out of Range.
I put "WorkbookName" back and ran it again and still errors out.