Conditionally Transfer Data Using VBA

[azad092]

Option Base 1
Sub DataEntryToExpense()
    Dim EntryCell   As Range, DataEntryRange As Range
    Dim wsExpense       As Worksheet
    Dim NextRow     As Long
    Dim Arr         As Variant
    Dim i           As Integer
    
    With ThisWorkbook
        'cells to copy from Data Entry sheet
        Set DataEntryRange = .Worksheets("DASHBOARD").Range("A4:C4")
        ' database sheet
        Set wsExpense = .Worksheets("Expense")
    End With
    
    'database ranges to send data entry values
    Arr = Array("A", "B", "C")
    
    'output array to database range
    With wsExpense
        NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        
        For Each EntryCell In DataEntryRange.Cells
            i = i + 1
            .Cells(NextRow, Arr(i)).Value = EntryCell.Value
            EntryCell.ClearContents
        Next
    End With
    
    'inform user
    MsgBox "New Record In Expense Has been Posted Succussfully", 64, "DOCTOR'S LAB (EXPENSE)"
End Sub

Hi
good morning
I am using this VBA code for posting data from sheet one sheet to another
I want to do this with a condition
I want when I enter a specific word (sheet name) in column B4, the data should be posted in the concerned sheet
please guide how I can do this