Loop through worksheets and copy to workbook

[NichoD]

Hello, I have a worksheet where everyday a new worksheet is created with todays date formated as YYMMDD. At open workbook, I would like vba to loop through all worksheets and copy worksheets with YYMMDD - 1 and onwards to another workbook, and thereafter be deleated from the current workbook. Could anyone help me with this?

Thank you in advance.

 

[Domenic]

I have assumed that the workbook running the code contains the worksheets that you want to move. If you want to refer to the active workbook, replace...

Set sourceWorkbook = ThisWorkbook

with

Set sourceWorkbook = ActiveWorkbook

I have also assumed that you want to move those worksheets to a new workbook. If you want to move them to an already opened workbook, replace...

Set destinationWorkbook = Workbooks.Add(xlWBATWorksheet)

with

Set destinationWorkbook = Workbooks("Book2.xlsx") 'change the workbook name accordingly

Here's the macro...

Option Explicit

Sub MoveWorkSheetsToOtherWorkbook()

    Dim sourceWorkbook As Workbook
    Set sourceWorkbook = ThisWorkbook
   
    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = Workbooks.Add(xlWBATWorksheet)
   
    Dim totalSheetCount As Long
    totalSheetCount = sourceWorkbook.Sheets.Count
   
    Dim sheetCount As Long
    sheetCount = 0
   
    Dim currentWorksheet As Worksheet
    For Each currentWorksheet In sourceWorkbook.Worksheets
        If currentWorksheet.Name Like "###### - 1" Then
            sheetCount = sheetCount + 1
            If totalSheetCount - sheetCount = 0 Then
                MsgBox "Unable to move " & currentWorksheet.Name & "!", vbExclamation
                Exit Sub
            End If
            currentWorksheet.Move after:=destinationWorkbook.Sheets(destinationWorkbook.Sheets.Count)
        End If
    Next currentWorksheet
   
    MsgBox "Number of worksheets moved: " & sheetCount, vbInformation
   
End Sub

Hope this helps!