Macro to copy range of cell from sheet1 to sheet2 based on a cell value in sheet2

hi drgwhizz, please check attachment

Thanks watersev,

The code works great for the example sheet. I have adjusted the layout slightly on sheet1 which means that the terms "product 1", "product 2", "product 3" now fall above and below the product data tables as well as heading each table. This means that the macro misses the table out when searching for the matching terms.

Is there a way to adjust the code to search from the first column along (i.e. left to right) rather than top to bottom (which it appears to be doing now). I've tried to tweak the code but my limited knowledge is making the task that bit harder!

I presume this is the line which needs adjusting but don't know what needs tweaking :

Set rng2copy = Sheets("Sheet1").UsedRange.Find(product, , xlValues, xlWhole)

I've attached a copy of the spreadsheet so you can see my explaination a bit better. One table will sit above the product tables and one below; each with the product names in them. This appears to be causing a problem with the macro.

ExampleSheet(11).xls

Thanks in advance.

can you post exact layout of the sheet1 data tables and charts? I'm not sure I quite understand additional info provided on the sheet.

ExampleSheet(12).xls

Apologies for the poor explaination; I know it would be easier to post the workbook I'm working within but it's too large and cumbersome for posting.

I've adjusted the example sheet to try and make it more clear. The table at the top of sheet1 (table 1) is getting in the way of the macro procedure. The product names within table 1 are picked up and copied rather than the product data tables (the ones with the graphs).

I hope that makes sense?!

Sub test()

Dim product As String, rng2copy As Range, rng4search As Range

With Sheets("Sheet2")

    product = .Range("a2")
    
    With Sheets("Sheet1")
        
        Set rng4search = .Range(.UsedRange.Find("Product Data Tables:", , xlValues, xlWhole), .Cells(Rows.Count, "c").End(xlUp))
    
        If Not rng4search Is Nothing Then Set rng2copy = rng4search.Find(product, , xlValues, xlWhole)
    
    End With

    If Not rng2copy Is Nothing Then
    
        Application.ScreenUpdating = 0
        
        .Range("a4:g9").ClearContents
        .ChartObjects.Delete
        rng2copy.Resize(6, 7).Copy .Range("a4")
        
        Application.ScreenUpdating = 1
        
    End If
    
End With

End Sub

Thanks again Watersev that's fixed the issue I created by changing the layout .

Just one last side question. If I decide to put formulas in the product data tables the macro will copy the formula cell references across to the new sheet. For example, if I place a formula which relates the column D in the product data tables to data in table 1. The outcome on the copied version (sheet2) will reference the same cells but on sheet2 rather than sheet1; this obviously will change the values in the copied table.

Is there a way to adjust this? Maintaining the references in the copied table back to the original data in sheet1?

Again I apologise if my explaination is poor. I've attached an updated example.

ExampleSheet(13).xls

Thanks for your help so far + rep for your patience.

the simplest way is to take that into account while inserting formulas: if the data is located on Sheet1 and will not be transfered over to Sheet2, fix it to Sheet1, example:

=C11*Sheet1!$F$3

The easiest VB option is to make a link of all numbers to Sheet1. Though it will not preserve formula but the "linked" value from Sheet1 (may be it will suit your needs):

Sub test()

Dim product As String, rng2copy As Range, rng4search As Range

With Sheets("Sheet2")

    product = .Range("a2")
    
    With Sheets("Sheet1")
        
        Set rng4search = .Range(.UsedRange.Find("Product Data Tables:", , xlValues, xlWhole), .Cells(Rows.Count, "c").End(xlUp))
    
        If Not rng4search Is Nothing Then Set rng2copy = rng4search.Find(product, , xlValues, xlWhole)
    
    End With

    If Not rng2copy Is Nothing Then
    
        Application.ScreenUpdating = 0
        
        .Range("a4:g9").ClearContents
        .ChartObjects.Delete
        rng2copy.Resize(2, 4).Copy .Range("a4")
        rng2copy.Offset(, 4).Resize(6, 3).Copy .Range("e4")
        .Range("a6:d8") = "=Sheet1!A" & rng2copy.Row + 2
        
        Application.ScreenUpdating = 1
        
    End If
    
End With

End Sub

Doh! Didn't think to change the cell references to include the sheet name also. I've done this as it helped me keep things a bit simpler on the VB front.

Thanks for the help, really appreciate it.

I'll mark this thread 'Solved'.