根据单元格值从工作簿复制和粘贴工作表到不同的工作簿

Question

我有一段巧妙的代码，它根据指定单元格中的特定文本输入隐藏/隐藏表。在Book1中的Sheet1中（比方说），如果我改变单元格A1中的文本（比方说文本是苹果、橘子等），我会在同一本书中的sheet2上得到某些表格（让我们称之为答题卡）。

现在，在另一本书中，我有一个表，其中包含所有可能的文本值(Apple，oranges，等等）。我想写一个代码，首先通过这个表，使值在book1.sheet1（“sheet1”）。range（“a1”）一步一步，从book1复制“答卷”。这样，最终的结果将是我拥有与book2加Sheet1中的产品数量一样多的页数。

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 ()
    .
    .
    .

我不能通过表，即，如果我的表是苹果，橘子和香蕉，我希望代码拿苹果，把它放在书本1，生成输出，复制它并粘贴到书本2。其他水果在新的床单上以此类推。代码给出一个下标超出范围的消息。

Answer 1

data_old这里是代码中的book1，表就在这里。您需要遍历数据以获取要复制的每个值。使用if语句，可以设置要复制内容的目标范围，在本例中为target。希望这能有所帮助。

    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