Hey , This is pretty crude, but it does the job.

Sub Dave()

Dim LastRow As Long
Dim ws As Worksheet
Dim qry As Worksheet
Application.ScreenUpdating = False

   Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Query"
  
Set ws = Worksheets("Sheet1")
Set qry = Worksheets("Query")
  ws.Range("C18:E42").Copy Destination:=qry.Cells(1, 5)
  LastRow = qry.Cells(qry.Rows.Count, 1).End(xlUp).Row
       With qry
          .Range("H1").Resize(25).FormulaR1C1 = "=LEFT(RC[-3],4)"
          .Rows("1:1").AutoFilter
          .Range("$E$1:$H$25").AutoFilter Field:=4, Criteria1:="2011"
          .UsedRange.Copy Destination:=Range("A1")
          .Columns("D:H").Delete Shift:=xlToLeft
       End With
Application.ScreenUpdating = True
End Sub