根据单元格值将工作表中的工作表复制并粘贴到其他工作簿

Question

I have a slick piece of code which hides/unhides tables based on a certain text input in a specified cell. In Sheet1 in Book1(say), if I change the text in cell A1(say the text is apples, oranges etc), I get certain tables on sheet2 in the same book (let's call it answer sheet).

Now in a separate book, in its sheet1, I have a table with all the possible text values (apples, oranges, etc). I would like to write a code which first goes through this table, make the value in Book1.Sheets("Sheet1").Range("A1") step by step, copies the "answer sheet" from book1. This way, the final result would be me having as many sheets as the number of products in book2 plus sheet1.

I am struggling to figure out how I get the code to reiterate through the table and keep creating new sheets and paste data.

The code I have written takes only the first element in the table from book2 and then copies it ina sheet. After that, I get the error "subscript out of range".

Sub_fruits()

Dim data_old as WorkBook
Dim data_new as Variant
Dim i As Long, LR As Long
Dim ws as Worksheet

ThisWorkbook.Sheets("Sheet1").Activate 'code is in book2
msgbox (______) 'to ask for file name 'to open book1

data_new = Application.GetOpenFIlename()
Set data_old = Workbooks.open(data_new)

Set ws = ThisWorkBook.ActiveSheet 'sheet1 in book2, the one with the     table
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

For i= 1 to LR
    'go through each cell in the table in book2.sheet1,
    'make a1 in book1 equal to cell value  and keep generating data on sheet2.book1).
    data_old.Sheets("sheet1").Range("a1").Value = _ 
    ws.Sheets("Sheet1").Range("a" & i).Value 
    'select data sheet from book1
    data_old.Sheets("Sheet2").Select
    Selection.Copy
    ws.sheets("Sheet2").select
    Range("a1").select
    'paste it onto sheet2 in book2
    ActiveSheet.Paste ()
    .
    .
    .

I am not able to go through the table ie if my table is apples, oranges and bananas, I would like the code to take apples, put it in the book1, generate output, copy that and paste it in book2. And so on for other fruits in new sheets. The code gives a subscript out of range message.

Answer 1

data_old here is book 1 in your code, where the table is. You need to Loop through your data to pick up each value that you're looking to copy. With an If statement, you can set the destination range of what's being copied, which is target in this example. Hope this helps.

    Dim wb As Workbook
    Set wb = Workbooks.Add

    Dim target As Worksheet
    Set target = wb.Worksheets(1)
    target.Range("A1") = "Fruit"

    Dim cell As Range
    For Each cell In data_old.Range("A2", data_old.Range("A" & Rows.Count).End(xlUp))
        If cell.Value = "apples" Then
            target.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = cell.Value
        End If
    Next cell
End Sub