VBA - Excel Copy and paste range with criteria

Question

I want to copy a range in Sheet1 range A1:A100 where in the each cells filled with value like "Animal", "Plant", "Rock", and "Sand". Then, I want paste in Sheet2 range B1:B100 with conditions if the value at Range A1:A100 is "Animal" paste with "1", if the value is "Plant" paste with "2", ect.

How I write the VBA code? With simple and reducing memory usage. My code :

Sub copyrange()
    Dim i           As Long
    Dim lRw         As Long
    Dim lRw_2       As Long


    Application.ScreenUpdating = False
    lRw = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    ThisWorkbook.Sheets("Sheet1").Activate

    For i = 1 To lRw
        Range("A" & i).Copy
        lRw_2 = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row + 1
        Sheets("Sheet1").Activate
        'I not sure for this one, the code is too long
            Select Case ThisWorkbook.Sheets("sheet1").Range("A" & i).Value
            Case "Animal"
            With Sheets("Sheet2").Range("B" & lRw_2)
            .Value = 1
            End With
            Case "Plant"
            With Sheets("Sheet2").Range("B" & lRw_2)
            .Value = 2
            End With
            Case "Rock"
            With Sheets("Sheet2").Range("B" & lRw_2)
            .Value = 3
            End With
            Case "Sand"
            With Sheets("Sheet2").Range("B" & lRw_2)
            .Value = 4
            End With
            End Select
        Sheets("Sheet1").Activate
    Next i
    Application.ScreenUpdating = True
End Sub

Thanks in advance.

Answer 1

Try this:

Option Explicit

Public Sub replaceItems()
    Application.ScreenUpdating = False
    With Sheets(2).Range("B1:B100")
        .Value2 = Sheets(1).Range("A1:A100").Value2
        .Replace What:="Animal", Replacement:=1, LookAt:=xlWhole
        .Replace What:="Plant", Replacement:=2, LookAt:=xlWhole
        .Replace What:="Rock", Replacement:=3, LookAt:=xlWhole
        .Replace What:="Sand", Replacement:=4, LookAt:=xlWhole
    End With
    Application.ScreenUpdating = True
End Sub