Question

我正在努力编写代码以将模板从单独的工作簿复制粘贴到特定的单元格中。复制的模板取决于文本条件，文本条件位于模板应复制到的每张纸上的单元格A4中。

浏览摘要工作簿中的每个工作表。
在每张纸上，在单元格A4中有一个引用模板的特定文本
打开包含多个模板工作表的模板工作簿。复制与摘要工作簿表的单元格A4中的文本对应的模板
返回摘要工作簿上的工作表，并将模板粘贴到单元格F14 Onwards。（所以我必须指定需要粘贴的位置的整个单元格区域，或者只是在粘贴之前引用它应该单击的单元格，这样就可以了。）
重复摘要工作簿中的所有工作表

以下是我的尝试，我收到错误“应用程序定义或异议定义错误”我突出显示了在下面的代码中触发错误的行。我认为这是因为我没有正确地调用模板书页。此外，如果我必须指定要复制和粘贴的单元格的确切范围，我也不会这样做，因为通常如果您复制整个工作表，那么您只能将其粘贴为整个工作表，而不是从特定单元格点粘贴。 / p>

感谢您的帮助！

  Sub PASTE()

Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim cell As Range
Dim ws As Worksheet

Set wb1 = ThisWorkbook
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)

Dim TemplateBook As Workbook
Set TemplateBook = Workbooks.Open(Filename:="C:\Users\VBA-NOOB\Desktop\EVERY Colour.xlsx")
DoEvents

For Each cell In Rng
   Set ws = wb1.Sheets(cell.Text)
   Select Case ws.Range("A4").Value   
            Case "Red & Green T"
            ws.Range("F14").Value = TemplateBook.Sheets("Red & Green")  '<--- is causing the error

   End Select
   Next cell



   End Sub

Answer 1

指定要从模板中复制的范围，如下所示：

Answer 2

     ws.Range("F14").Value = TemplateBook.Sheets("Red & Green")  '<--- is causing the error

在这一行中，您使用了两种不同类型的对象。您试图说单元格F14的值是整个工作表Red & Green - 而不仅仅是Red & Green的单元格，而是工作表对象。这就是您收到错误的原因。

我不清楚你究竟想要做什么，但是 - 想要获取模板表的所有内容并将它们粘贴到从基本单元开始的目标工作表中（F14））？如果是这样，你可以这样做：

ws.range("F14").value = TemplateBook.sheets("Red & Green").Range("A1").value

...或类似的，指定源范围的大小，而不是尝试使用＆＃34;所有单元格＆＃34;。

Answer 3

猜猜。你能这样试试吗？

Option Explicit

Sub PASTE()

    Dim wb1             As Workbook
    Dim Sht             As Worksheet
    Dim Rng             As Range
    Dim Rng2            As Range
    Dim cell            As Range
    Dim ws              As Worksheet
    Dim TemplateBook    As Workbook

    Dim rng3            As Range

    Set wb1 = ThisWorkbook
    Set Sht = wb1.Worksheets("Summary")
    Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)

    Set TemplateBook = Workbooks.Open(Filename:="C:\Users\VBA-NOOB\Desktop\EVERY Colour.xlsx")
    DoEvents

    For Each cell In Rng
        Set ws = wb1.Sheets(cell.Text)
        Select Case ws.Range("A4").Value
        Case "Red & Green T"

            ws.Range("F14") = TemplateBook.Sheets("Red & Green").Range("F14")  '<--- is causing the error

        End Select
    Next cell

End Sub

我所做的改变是：

ws.Range("F14") = TemplateBook.Sheets("Red & Green").Range("F14")

在您的情况下，您将工作表分配给范围。这是不可能的。

根据条件

3 个答案: