根据特定年份复制和粘贴列数据

Question

I have an excel sheet with prices from previous years (prices of materials used in construction) and I am trying to make a code that will show me all the data based on a certain year that i'd choose.

Here is what my list/excel looks like

In cell E3 (in yellow), I input the year that i wish to "analyse" and with that year, i need a function that will go search in the columns K to Q (and more since every year, prices change), search for that specific year, and if it corresponds to the same one I input in cell E3, will copy and paste all the data of sales, reg. loc.and spec. loc.into the columns F, G and H.

I don't know if it's easier that, instead of putting the year in cells K3, L3 and M3 (for example), if I put it in cell N3, R3, etc. (in red) instead, the function will take the 3 previous columns and copy/paste them in columns F to H.

Here is the option 2, if it makes the coding easier

Also the list goes on until row 381, and there's a potential that more data will be input eventually so take into consideration as if the list had an infinite amount of rows. However, for the columns, it's always fixed to 3 columns.

FYI: it is not a school project, i'm just trying to find a way to simplify my work instead of manually searching and copy/pasting the data everytime. I hope there's a solution for this, thank you!!

Answer 1

Please, try the next code. It should do what (I understand) you need. It should be fast, not using clipboard for copying. As I suggested in my comment, it firstly searches/finds in the third row the year (long or string, as it is written in "E3"), starting searching after "E3" , then copying the range built according to the found cell. If not a match is found, the code exits on the line If rngFirstCol Is Nothing Then Exit Sub . You may place a message there, to warn in such a case. It works on your first arrangement/picture , meaning that the year must be filled in the third row of the first column where from the necessary data should be collected/copied:

Sub ExtractPricesPerYear()
  Dim sh As Worksheet, lastR As Long, rngFirstCol As Range, lngYear, necCol As Long
  
  Set sh = ActiveSheet 'use here your necessary sheet
   lngYear = sh.Range("E3").value 'the year to be searched
  Set rngFirstCol = sh.rows(3).Find(What:=lngYear, After:=sh.Range("E3"), LookIn:=xlValues, Lookat:=xlWhole)
  If rngFirstCol Is Nothing Then Exit Sub
  necCol = rngFirstCol.Column
  lastR = sh.cells(sh.rows.count, necCol).End(xlUp).row
  With sh.Range(rngFirstCol.Offset(1), sh.cells(lastR, necCol + 2))
        sh.Range("E4").Resize(.rows.count, .Columns.count).value = .value
  End With
End Sub

Please, send some feedback after testing it.

And another issue: It is good to show us what you tried by your own. If not a piece of code, at least, something to prove that you investigated and had some ideas about the task to be solved, asking for hints, suggestions etc. proving that you know something about how it can be done...

Edited :

Following your requirement from last comment, please use the next solution. Please, copy the next code in the respective sheet code module (right click on the sheet name, then choose View Code ):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim lastR As Long, lastRF As Long, rngFirstCol As Range, lngYear, necCol As Long
  
    If Target.Address(0, 0) = "E3" Then 'the code exits for any other change on the sheet
         lngYear = Target.value 'the year to be searched
        Set rngFirstCol = Me.rows(3).Find(What:=lngYear, After:=Me.Range("E3"), LookIn:=xlValues, Lookat:=xlWhole)
        If rngFirstCol Is Nothing Then MsgBox "No such year found on the third row...:":   Exit Sub
        
        necCol = rngFirstCol.Column 'column number of the found cell
        lastR = Me.cells(Me.rows.count, necCol).End(xlUp).row   'last row on the found column
        lastRF = Me.Range("F" & Me.rows.count).End(xlUp).row  'last row on F:F column (to delete its content, if any)
           If lastRF > 4 Then Me.Range("F4:H" & lastRF).ClearContents 'clear the range to make place for the new data
        With Me.Range(rngFirstCol.Offset(1), Me.cells(lastR, necCol + 2))
              Me.Range("F4").Resize(.rows.count, .Columns.count).value = .value
        End With
    End If
End Sub