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

Question

我有一段光滑的代码，它基于在指定单元格中输入的某些文本来隐藏/取消隐藏表。 在Book1的Sheet1（例如）中，如果我更改单元格A1中的文本（例如，文本是苹果，橙子等），则我会在同一本书的sheet2上获得某些表格（我们将其称为答题纸）。

现在，在另一本书的sheet1中，我有一个表，其中包含所有可能的文本值（苹果，橘子等）。 我想编写一个代码，该代码首先通过此表，逐步在Book1.Sheets（“ Sheet1”）。Range（“ A1”）中进行赋值，从book1复制“答案纸”。 这样，最终结果将是我拥有的书数与book2 plus sheet1中的产品数一样多。

我正在努力弄清楚如何获得在表中重复的代码，并继续创建新的工作表并粘贴数据。

我编写的代码仅从book2中获取表中的第一个元素，然后将其复制到工作表中。 之后，出现错误“下标超出范围”。

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

我无法浏览表格，即如果我的桌子是苹果，橘子和香蕉，我希望代码获取苹果，将其放入book1中，生成输出，将其复制并粘贴至book2中。 以此类推，获取新表中的其他水果。 该代码给出了下标超出范围的消息。

Answer 1

data_old这是您的代码data_old 1所在的书1。 您需要遍历数据以选择要复制的每个值。 使用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