Choosing wich sheets to pick while consolidating data using VBA

[Doomglazer]

Hello

I have an Excell with a new sheet with data for every working day. The sheets are labeled 0101,0201,0301,.... and this goes on till the end of the year.
I am using the following VBA code to consolidate all the data into a Master sheet. Now im looking for a way where i can say that i only want the data from 0104 to 3004 for example to be on the "Master" sheet

This is the code i use but it captures all the days. But i would like to provide a range where it will then run and provide me the data.

Sub Merge_Sheets()

Dim startRow, startCol, lastRow, lastCol As Long
Dim headers As Range

'Set Master sheet for consolidation
Set mtr = Worksheets("Master")

Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)

'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column

Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets
'except the master sheet from looping
If ws.Name <> "Master" Then
ws.Activate
lastRow = Cells(Rows.Count, startCol).End(xlUp).Row
lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
'get data from each worksheet and copy it into Master sheet
Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy _
mtr.Range("A" & mtr.Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next ws

Worksheets("Master").Activate

End Sub

Thank you in advance

 

[My Aswer Is This]

I have a couple questions.
1. Why try to determine the last cell in each row with data?
Why not just copy the entire row?
2. Do you want to copy each header row which is normally considered to be row 1
Into the master sheet or do not copy each Row (1)
And will each sheet always have data in column A?
This way we tell script to always look down column A till last cell in column A with data
And I suggest we have an input Box popup asking for sheet numbers
Like sheets 100 to 300 or so.
This would be sheet numbers like 100 to 500
Not sheet names.
Would that work?

 

[My Aswer Is This]

I now can use sheet name if you want

Assuming sheet names will be numbers like you mentioned.

 

[Doomglazer]

I now can use sheet name if you want

Assuming sheet names will be numbers like you mentioned.

The sheet names are actually dates but that doesnt matter. If there would be an input box where i can select from 0104 to 3004 for example and it would choose only those sheets that would be great

 

[My Aswer Is This]

You can try this:
I asked about headers but you did not answer this question:

I asked:
2. Do you want to copy each header row which is normally considered to be row 1
Into the master sheet or do not copy each Row (1)
And will each sheet always have data in column A?

I'm assuming you do not want header rows copied and I assume each sheet will have data in column A. See I need that so I know how many rows on each sheet do i need to copy.

But try this and we will see what happens.
Two Input boxes will popup.
Put first sheet name in first popup
Put Last sheet name in second popup

Sub Copy_Sheets_To_Master()
'Modified 7/4/2022  5:25:44 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim n As Long
n = Sheets.Count
Dim Lastrow As Long
Dim Lastrowa As Long

Dim Startsheet As Long
Dim Lastsheet As Long
Dim ans As Long
Startsheet = InputBox("Enter first sheet number", "Must be greater then 1", "001")
Lastsheet = InputBox("Enter last sheet number", "Must be less then" & n + 1, "0020")

For i = 2 To n

    Select Case Sheets(i).Name
        Case Startsheet To Lastsheet
            Lastrowa = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
            Sheets(i).Rows(2).Resize(Lastrow).Copy Sheets("Master").Rows(Lastrowa)
        End Select
Next


Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Try this:
If you have an error, you will get a Message box popup

Sub Copy_Sheets_To_Master()
'Modified  7/4/2022  5:37:19 PM  EDT
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim n As Long
n = Sheets.Count
Dim Lastrow As Long
Dim Lastrowa As Long

Dim Startsheet As Long
Dim Lastsheet As Long
Dim ans As Long
Startsheet = InputBox("Enter first sheet number", "Must be greater then 1", "001")
Lastsheet = InputBox("Enter last sheet number", "Must be less then" & n + 1, "0020")

For i = 2 To n

    Select Case Sheets(i).Name
        Case Startsheet To Lastsheet
            Lastrowa = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
            Sheets(i).Rows(2).Resize(Lastrow).Copy Sheets("Master").Rows(Lastrowa)
        End Select
Next


Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had some type Problem"
Application.ScreenUpdating = True

End Sub

 

[Doomglazer]

Try this:
If you have an error, you will get a Message box popup

Sub Copy_Sheets_To_Master()
'Modified  7/4/2022  5:37:19 PM  EDT
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim n As Long
n = Sheets.Count
Dim Lastrow As Long
Dim Lastrowa As Long

Dim Startsheet As Long
Dim Lastsheet As Long
Dim ans As Long
Startsheet = InputBox("Enter first sheet number", "Must be greater then 1", "001")
Lastsheet = InputBox("Enter last sheet number", "Must be less then" & n + 1, "0020")

For i = 2 To n

    Select Case Sheets(i).Name
        Case Startsheet To Lastsheet
            Lastrowa = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
            Sheets(i).Rows(2).Resize(Lastrow).Copy Sheets("Master").Rows(Lastrowa)
        End Select
Next


Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had some type Problem"
Application.ScreenUpdating = True

End Sub

Thank you allready for the help. I tried the code and when I only select one sheet for example start sheet "1404" and last sheet "1404" it works perfectly. But when I set a larger range for example start "1304" and end sheet "1404" i get more then the 2 I asked for. I get the data from sheets "1401,1402,1403,1305,1306" The Sheets follow each other like a date. so the 13th day of month 4 the 14th day of month 4. Your code does the correct action getting anything between 1304 and 1404 but actually both sheets are next to each other and there is nothing in between.
I hope this can help you.

 

[My Aswer Is This]

Not sure how to solve that. In most cases dates are entered as Day Month Year.
But you may live in a country where dates are entered like Month Day Year. I believe it's done that way in most European countries.
I will have to think more and see what I can do.

Show me exactly how the sheet names look.

is it like this? MMM/DD/YYYY
Like Jan/14/2022

I do not think It can work off sheet names.
I think we will have to work off sheet numbers

Like from sheet 20 to 40

You would have to put in inputbox 1 Like 10 and in inputbox 2 the number 20

 

[Doomglazer]

Not sure how to solve that. In most cases dates are entered as Day Month Year.
But you may live in a country where dates are entered like Month Day Year. I believe it's done that way in most European countries.
I will have to think more and see what I can do.

Show me exactly how the sheet names look.

is it like this? MMM/DD/YYYY
Like Jan/14/2022

I do not think It can work off sheet names.
I think we will have to work off sheet numbers

Like from sheet 20 to 40

You would have to put in inputbox 1 Like 10 and in inputbox 2 the number 20

Its actually a number but has to be seen as a date. As you can see in the example I uploaded. 0104 is infact the first of april first the day (01) and then the month (04) so 0104 is the first of april.

 

[My Aswer Is This]

Try this:

Sub Copy_Sheets_To_Master()
'Modified  7/5/2022  5:32:39 AM  EDT
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim n As Long
n = Sheets.Count
Dim Lastrow As Long
Dim Lastrowa As Long
Dim Startsheet As String
Dim Lastsheet As String
Dim ans As Long
Dim anss As Long

Startsheet = InputBox("Enter First Sheet Name")
Lastsheet = InputBox("Enter Last Sheet Name")
ans = Sheets(Startsheet).Index
anss = Sheets(Lastsheet).Index

    For i = 2 To n
        Select Case Sheets(i).Index
            Case ans To anss
                Lastrowa = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
                Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
                Sheets(i).Rows(2).Resize(Lastrow).Copy Sheets("Master").Rows(Lastrowa)
        End Select
    Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had some type Problem"
Application.ScreenUpdating = True

End Sub