Excel VBA：PasteValues 如何在第二个循环中给出运行时错误 1004答案

【问题标题】：Excel VBA: how come PasteValues gives Run-time error 1004 in second loopExcel VBA：PasteValues 如何在第二个循环中给出运行时错误 1004
【发布时间】：2018-11-10 14:52:22
【问题描述】：

我有一个循环代码，它调用以下代码 PasteValue() 以生成一个选项卡，其中仅包含每个循环/测试用例的值。当我最初运行循环时，会根据需要生成 test1 的选项卡。但是当它移动到 test2 时，会正确创建一个新选项卡，但是在尝试粘贴值（粗线）时出现运行时错误 1004。有人能说出这个错误的原因吗？怎么第一次循环成功，第二次失败了？

Private Sub PasteValue()

Dim tabName As String
Dim filePath As String
Dim ws As Worksheet

tabName = Sheets("Main").Range("D5").Value
filePath = "C:\Users\ME\Desktop\My Work\test\All Test Results Paste Values.xlsx"

Worksheets("Main").Range("Summary").Select
Worksheets("Main").Range("Summary").Copy

' create workbook if it does not exist
If Dir(filePath) = "" Then
    Workbooks.Add
    ActiveWorkbook.Sheets.Add().Name = tabName
Else
    Workbooks.Open fileName:=filePath
    If sheetExists(tabName) Then
        Sheets(tabName).Select
    Else
        ActiveWorkbook.Sheets.Add().Name = tabName
    End If
End If

' paste value and format
With Worksheets(tabName).Range("A1")
    **.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False**
    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

' save workbook
If Dir(filePath) = "" Then
    ActiveWorkbook.SaveAs fileName:=filePath
Else
    ActiveWorkbook.Save
End If

End Sub

【问题讨论】：

您正在添加一个新的工作簿。然后，当您点击With 语句时，您会为该范围提供一个工作表，而不是它应该在哪个工作簿上。您需要将新工作簿添加到该行。我会做类似的事情：Dim newWB as Workbook // Set newWB = Workbooks.Add // newWB.Sheets.Add().Name = tabName // ... // With newWB.Worksheets(tabName).Range("A1")...。但是您还需要确保在第一个循环中它使用原始工作簿，所以在那里做同样的事情。
@BruceWayne 感谢您的帮助。对于第二个循环，只应创建一个新工作表。不是工作簿。新工作簿仅在第一个循环中创建，所以我认为这不是问题。
就在给出错误的行之前，当您运行它两次时添加Debug.print ActiveWorkbook.name（第一次使其正常工作），两个循环的即时窗口中显示的名称是否相同？
@BruceWayne 两个循环的名称相同
@BruceWayne 我看到的一个模式是代码无法粘贴到在 C: 位置指定的工作簿中创建的新工作表中。它在第一个循环中工作，因为工作簿尚未保存在 C: 位置。将其保存到特定文件位置后，假设在第二个循环中，可以创建一个新工作表，但粘贴值会以某种方式失败。

标签： vba excel

【解决方案1】：

我尝试使用完全合格的范围来实现此功能。检查一下，看看它是否有效，您可能（可能）需要调整，但如果您有任何问题，请告诉我。

我的主要问题是tabName = SheetS("Main")... 在哪个工作簿中？

Private Sub PasteValue()
Dim tabName As String
Dim filePath As String
Dim ws As Worksheet
Dim mainWB As Workbook, newWB As Workbook

' What workbook is this on?
Set mainWB = Workbooks.Open("C:\Users\ME\Desktop\My Work\test\MAIN WORKBOOK.xlsm")

tabName = mainWB.Sheets("Main").Range("D5").Value

filePath = "C:\Users\ME\Desktop\My Work\test\All Test Results Paste Values.xlsx"

' create workbook if it does not exist
If Dir(filePath) = "" Then
    tabName = mainWB.Sheets("Main").Range("D5").Value
    Set mainWB = Workbooks.Add
    mainWB.Sheets.Add().Name = tabName
Else
   Set mainWB = Workbooks.Open(filePath)
    If Not SheetExists(tabName) Then
        mainWB.Sheets.Add().Name = tabName
    End If
End If

' paste value and format
With mainWB.Worksheets(tabName).Range("A1")
    mainWB.Worksheets("Main").Range("Summary").Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

' save workbook
If Dir(filePath) = "" Then
    mainWB.SaveAs Filename:=filePath
Else
    mainWB.Save
End If

End Sub

【讨论】：

主工作表位于完成计算并存储 VBA 代码的工作簿中。
@Fammerjammer - 查看我的编辑。我添加了一条使用该主工作簿的行。同样，您可能需要调整/编辑它，但它应该可以工作。