Trying to call my worksheet by current month

[Eric Penfold]

This code is it to call active sheet as current month. But I can`t work out how to make it automictically call the tab as current month.

    Set Wb = Workbooks("2023 Grays Back Order.xlsm")
    mydate = Format(Now, "mm")
     Set ws = ThisWorkbook.Worksheets.Name = mydate

Sub VLookup()

    Dim SrcPro As Workbook, SrcReD As Workbook, SrcTyp As Workbook, Wb As Workbook
    Dim ws As Worksheet, SrcPro_ws As Worksheet, SrcRed_ws As Worksheet, SrcTyp_ws As Worksheet
    Dim wsLRow As Long, wsLCol As Long, col_wsProd As Long, col_wsRed As Long, col_wsTyp As Long
    Dim i As Integer
    Dim LRow As Long, LCol As Long
    Dim FileToOpen As Variant, arrDes_Rng As Variant
    Dim SrcPro_Rng As Range, SrcRed_Rng As Range, SrcTyp_Rng As Range, Des_Rng As Range, Cell As Range
    Dim BlCell As Boolean
    Dim MDate As Object
    
    BlCell = False
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set Wb = Workbooks("2023 Grays Back Order.xlsm")
    mydate = Format(Now, "mm")
     Set ws = ThisWorkbook.Worksheets.Name = mydate
    
    On Error Resume Next
    ws.ShowAllData
   
    FileToOpen = ("S:\PURCHASING\Stock Control\Reports\Back Order Admin\Product.xlsx")
       Workbooks.Open FileToOpen
    FileToOpen = ("S:\PURCHASING\Stock Control\Reports\Back Order Admin\Back Order Release Date.xlsx")
       Workbooks.Open FileToOpen
    FileToOpen = ("S:\PURCHASING\Stock Control\Reports\Back Order Admin\Order Type.xlsx")
       Workbooks.Open FileToOpen
      
    Set SrcPro = Workbooks("Product.xlsx")
    Set SrcReD = Workbooks("Back Order Release Date.xlsx")
    Set SrcTyp = Workbooks("Order Type.xlsx")
    
    Set SrcPro_ws = SrcPro.Sheets("Sheet1")
    Set SrcRed_ws = SrcReD.Sheets("Sheet1")
    Set SrcTyp_ws = SrcTyp.Sheets("Sheet1")

    LRow = SrcPro_ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set SrcPro_Rng = SrcPro_ws.Range("A2:C" & LRow)
    
    LRow = SrcRed_ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set SrcRed_Rng = SrcRed_ws.Range("A2:C" & LRow)
    
    LRow = SrcTyp_ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set SrcTyp_Rng = SrcTyp_ws.Range("A2:C" & LRow)

    wsLRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
    wsLCol = 16
    Set Des_Rng = ws.Range(ws.Cells(2, "A"), ws.Cells(wsLRow, wsLCol))

    arrDes_Rng = Des_Rng.Value
    arrDes_Rng = Application.Trim(arrDes_Rng)

    col_wsProd = 5
    col_wsRed = 3
    col_wsTyp = 3
    
    Des_Rng.Columns(col_wsProd).Value = Application.Index(arrDes_Rng, 0, col_wsProd)
    Des_Rng.Columns(col_wsRed).Value = Application.Index(arrDes_Rng, 0, col_wsRed)
    Des_Rng.Columns(col_wsTyp).Value = Application.Index(arrDes_Rng, 0, col_wsTyp)
    
    If ws.Name <> "Summary" And ws.Name <> "Trend" And ws.Name <> "Supplier BO" And ws.Name <> "Diff Depot" _
    And ws.Name <> "BO Trend WO" And ws.Name <> "BO Trend WO 2" And ws.Name <> "Different Depot" Then

            With ws
            

                            
                          For i = 2 To wsLRow
                        Set Cell = .Range("K" & i).Value
                       If IsEmpty(.Cells(i, 11).Value) Then
                        .Range("K" & i).Value = .Application.IfError(.Application _
                            .VLookup(Des_Rng.Cells(i - 1, col_wsProd), SrcPro_Rng, 2, 0), "")
                            .Range("K2:K" & wsLRow).HorizontalAlignment = xlCenter
                            End If
                           Next i
                          
                         For i = 2 To wsLRow
                        Set Cell = .Range("M" & i).Value
                        If IsEmpty(.Cells(i, 13).Value) Then
                           .Range("M" & i).Value = .Application.IfError(.Application _
                            .VLookup(Des_Rng.Cells(i - 1, col_wsTyp), SrcRed_Rng, 2, 0), "")
                            .Range("M2:M" & wsLRow).HorizontalAlignment = xlCenter
                          End If
                          Next i
                          
                         For i = 2 To wsLRow
                        Set Cell = .Range("O" & i).Value
                       If IsEmpty(.Cells(i, 15).Value) = True Then
                        .Range("O" & i).Value = .Application.IfError(.Application _
                            .VLookup(Des_Rng.Cells(i - 1, col_wsTyp), SrcTyp_Rng, 2, 0), "")
                           .Range("O2:O" & wsLRow).HorizontalAlignment = xlCenter
                          End If
                          Next i
                          
                          For i = 2 To wsLRow
                        Set Cell = .Range("P" & i).Value
                        If IsEmpty(.Cells(i, 16).Value) Then
                        .Range("P" & i).Value = .Application.IfError(.Application _
                            .VLookup(Des_Rng.Cells(i - 1, col_wsProd), SrcPro_Rng, 3, 0), "")
                            .Range("P2:P" & wsLRow).HorizontalAlignment = xlLeft
                        End If
                        Next i

                End With
   
    SrcPro.Close
    SrcReD.Close
    SrcTyp.Close
    
    Call Number_To_Text_Macro

    End If
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

 

[Eric Penfold]

Thanks works fine now