Copy & Paste a range after matching a input value with a column

Dear Friends,

I request a macro do do the following:

1) Take input in a dialog box
2) As per that input, check & match with values in a column
3) select & copy the data
4) paste it from next to last value in a column

I have attached a sample file in which I gave sample data and details of How & What to do.

I request experts for their support.

Is it what you need?

Option Explicit

Sub MyJob()
Dim InVal As String
Dim F
Dim LR As Integer
Dim WkRg As Range

    InVal = Application.InputBox("Enter your choice", " Year selection", "2020-21", Type:=2)
    Application.ScreenUpdating = False
    ActiveSheet.AutoFilterMode = False
    LR = Cells(Rows.Count, 2).End(3).Row
    Set WkRg = Range("$A$3:$F" & LR)

    If (InVal = "False") Then Exit Sub

    WkRg.AutoFilter Field:=4, Criteria1:=InVal
    Set WkRg = WkRg.Offset(0, 1).SpecialCells(xlCellTypeVisible)
    ActiveSheet.AutoFilterMode = False
    WkRg.Copy Destination:=Cells(LR + 1, 2)
    Cells(LR + 1, 1).EntireRow.Delete
    Application.ScreenUpdating = False '
End Sub

Sir,

Thanks for your code. Perfectly working.

But, just a request. I changed a column.

That is, need to copy & paste columns C to F only (in the previous sample, it was B to F).

I tried changing code. But, ended up with errors.

Please help me to resolve.

Here you are

Option Explicit

Sub MyJob()
Dim InVal As String
Dim F
Dim LR As Integer
Dim WkRg As Range

    InVal = Application.InputBox("Enter your choice", " Year selection", "2020-21", Type:=2)
    Application.ScreenUpdating = False
    ActiveSheet.AutoFilterMode = False
    LR = Cells(Rows.Count, 2).End(3).Row
    Set WkRg = Range("$A$3:$F" & LR)

    If (InVal = "False") Then Exit Sub
    WkRg.AutoFilter Field:=4, Criteria1:=InVal          '  Filter on column D => 4
    Set WkRg = WkRg.Offset(0, 2).SpecialCells(xlCellTypeVisible)    '  Collect from column C => 2
    ActiveSheet.AutoFilterMode = False
    WkRg.Copy Destination:=Cells(LR + 1, 3)             '  Paste in column C => 3
    Cells(LR + 1, 1).EntireRow.Delete
    Application.ScreenUpdating = False '
End Sub

Sir,

Thanks for your updated code.

But again the same issue.

As some formula is there in Columns A4:B5001, I dont want to disturb it while executing your Code.

Therefore, we need to copy & paste only columns C:F, only (without disturbing col A & B).

Please Sir.

See nexr revision.
If does not work please attach a new Excel sample with formulas

Option Explicit

Sub MyJob()
Dim InVal As String
Dim F
Dim LR As Integer
Dim WkRg As Range

    InVal = Application.InputBox("Enter your choice", " Year selection", "2020-21", Type:=2)
    Application.ScreenUpdating = False
    ActiveSheet.AutoFilterMode = False
    LR = Cells(Rows.Count, 3).End(3).Row
    Set WkRg = Range("$A$3:$F" & LR)

    If (InVal = "False") Then Exit Sub
    WkRg.AutoFilter Field:=4, Criteria1:=InVal          '  Filter on column D => 4
    Set WkRg = WkRg.Offset(0, 2).SpecialCells(xlCellTypeVisible)    '  Collect from column C => 2
    ActiveSheet.AutoFilterMode = False
    WkRg.Copy Destination:=Cells(LR + 1, 3)             '  Paste in column C => 3
    Cells(LR + 1, 3).Resize(1, 4).Delete Shift:=xlUp
    Application.ScreenUpdating = False '
End Sub

Sir,

As stated, I hereby attached the Sample file with your latest code.

Also, mentioned the formulas in Column A & B which are not to be disturbed.

Request your kind support.

You need to lock row in the formula
B4 =IFERROR(VLOOKUP(C4,Sheet2!$B$1:$C$21,2,FALSE),"")


Then try

Sub pes()
Dim r As Long
    Application.ScreenUpdating = False
   r = Cells(Rows.Count, 3).End(xlUp).Row
        Range("C3:H" & r).AutoFilter Field:=2, Criteria1:=Application.InputBox("Select Year", "Year1", "2020-21")
        Range("C4:H" & r).SpecialCells(12).Copy Cells(r + 1, 3)
        Range("C3:H" & r).AutoFilter
        Application.ScreenUpdating = True
End Sub

As Bo_Ry mentioned it, keep in mind to freeze the range of the Vlookup
In the next code formulas are copied down

Option Explicit

Sub MyJob()
Dim InVal As String
Dim LR As Integer
Dim WkRg As Range

    InVal = Application.InputBox("Enter your choice", " Year selection", "2020-21", Type:=2)
    If (InVal = "False") Then Exit Sub
    ActiveSheet.AutoFilterMode = False
    LR = Cells(Rows.Count, 3).End(3).Row
    Set WkRg = Range("$C$3:$F" & LR)
    WkRg.AutoFilter Field:=2, Criteria1:=InVal          '  Filter on column D => 2
    Set WkRg = Range("$C$4:$F" & LR).SpecialCells(xlCellTypeVisible)
    WkRg.Copy Destination:=Cells(LR + 1, 3)             '  Paste in column C => 3
    ActiveSheet.AutoFilterMode = False
    LR = Cells(Rows.Count, 3).End(3).Row
    Range("A4:B4").AutoFill Destination:=Range("A4:B" & LR)
    
End Sub

Thanks a lot to PCI & Bo_Ry.

I got the solution.

You're welcome and thanks for the rep.