Copy range based on matching column heading

[jcaple]

Hi all. I'm really struggling to find any code that will work for this scenario, after trying for hours I'm just about ready to give up. As you will see below, I'm a complete newbie when it comes to VBA.

I have two workbooks, Entry_Sheet (where I need to paste the data) and Data_Sheet (where all of the data is stored).
Entry_Sheet has column headings along row 1 (D1:R1) but is otherwise blank.
Data_Sheet has column headings along row 1 (A1:FI1) and 300 rows of data below each column heading.
What I want to be able to do is to take the value (text, result of a formula) from D1 in Entry_Sheet, and find an exact match with one of the column headings in Data_Sheet. When it has found the value (there is only one occurrence), I want it to highlight a range of 300 values in that column, which is offset by 4 rows below. I can then copy this and paste it into Entry_Sheet, from D2 downwards. I'd then repeat the process for E1, F1 etc.

I tried to find a solution through scouring the net, but have just been going around in circles. I wondered if I could use a simple Find but then couldn't work out how to change the 'Value' part to reference another workbook. Even pasting the initial stages of the code I put together into VB caused Excel to seize up...

Data_Sheet.Rows(1).Find(What:="Value", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

The only bit I could get working was selecting the offset range (shown below), but that's not much use if I can't perform a search and select the relevant column heading in Data_Sheet.

ActiveCell.Offset(4, 0).Resize(300, 1).Select

Thanks for looking, and especially if someone out there is able to help

 

[L. Howard]

Data_Sheet.Rows(1).Find(What:="[B]Value[/B]", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

Try making the FIND code lines something like this.
Where myFnd is set to the header of choice.
This code would SELECT the 300 rows, the comment out line would copy the 300 rows to sheet1, column N starting in row 2.

Dim rngFnd As Range
Dim myFnd As String

 
With Sheets("Data_Sheet")
 
    Set rngFnd = .Range("A1:FI1).Find(What:=myFnd, _
                     LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                     SearchDirection:=xlNext, MatchCase:=False)

    If Not rngFnd Is Nothing Then

        rngFnd.Offset(4, 0).Resize(300, 1).Select   'Copy Sheets("Sheet1").Range("N2")
       
      Else

        MsgBox "No match found."
        Exit Sub
        
    End If
End With

Howard

 

[jcaple]

Thanks for your help Howard, it saved my laptop from being thrown against the nearest wall! It's all now working as intended