【问题标题】:Copying and pasting sheets from a workbook to a different workbook based on cell value根据单元格值将工作簿中的工作表复制并粘贴到不同的工作簿
【发布时间】:2019-08-26 22:02:59
【问题描述】:

我有一段巧妙的代码,可以根据指定单元格中的特定文本输入隐藏/取消隐藏表格。在 Book1 的 Sheet1(比如)中,如果我更改单元格 A1 中的文本(比如文本是苹果、橙子等),我会在同一本书的 sheet2 上获得某些表格(我们称之为答题纸)。

现在在另一本书的 sheet1 中,我有一个表格,其中包含所有可能的文本值(苹果、橙子等)。我想编写一个代码,首先通过该表,逐步在 Book1.Sheets("Sheet1").Range("A1") 中取值,从 book1 复制“答题纸”。 这样,最终结果就是我拥有的工作表数量与 book2 中的产品数量加上 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。以此类推,用于新床单中的其他水果。 该代码给出了一个下标超出范围的消息。

【问题讨论】:

  • 那么,您在行上遇到错误:data_old.Sheets("Sheet2").Select ?如果是,您确定工作表名称中没有错字吗?

标签: excel vba


【解决方案1】:

data_old 这是代码中的第 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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-10-25
    相关资源
    最近更新 更多