粘贴特殊错误 – 1004 VBA Excel

我正在尝试创build一个循环来复制源工作表中的单元格中的数据，并粘贴到目标工作表中的特定单元格中。 一旦单元格被粘贴，我需要它来保存该文件的副本，然后粘贴源工作表中的下一个值。代码是：

Private Sub CommandButton1_Click() Dim wbTarget As Worksheet Dim wbSource As Worksheet Dim SaveLoc As String Dim FName As String Dim i As Long Set wbSource = Sheets("Sheet3") Set wbTarget = Sheets("Sheet1") wbSource.Activate Range("A1").Activate Do While ActiveCell.Value <> "" DoEvents ActiveCell.Copy For i = 1 To 30 wbTarget.Activate With ActiveSheet wbTarget.Range("E5").Select Selection.PasteSpecial Paste:=xlPasteColumnWidths Selection.PasteSpecial Paste:=xlPasteValues ThisWorkbook.Save Application.CutCopyMode = False End With SaveLoc = "H:\Services\Test Output\Term_" FName = Range("B5") ActiveWorkbook.SaveCopyAs FileName:=SaveLoc & FName & ".xls" 'FileFormat:=xlNormal Application.DisplayAlerts = False Next i wbSource.Select ActiveCell.Offset(1, 0).Activate Loop Application.ScreenUpdating = True End Sub 

当我运行这个，我得到一个

运行时错误1004。

请告知如何解决这个问题。
先谢谢你。

Answer 1

尝试下面的代码，而不使用Activate ， ActiveCell ， Select和Selection ，而是使用完全限定Range和Worksheet对象。

在代码中作为注释解释（也是关于你的代码的一些问题）。

码

 Option Explicit Private Sub CommandButton1_Click() Dim wbTarget As Worksheet Dim wbSource As Worksheet Dim SaveLoc As String Dim FName As String Dim i As Long, lRow As Long Set wbSource = Sheets("Sheet3") Set wbTarget = Sheets("Sheet1") ' SaveLoc string never changes, doesn;t need to be set every time inside the loops SaveLoc = "H:\Services\Test Output\Term_" ' you never qualifed the range with on of the worksheets (I'm guessing here it's "Sheet3" FName = wbTarget.Range("B5").Value Application.ScreenUpdating = False lRow = 1 Do While wbSource.Range("A" & lRow).Value <> "" wbSource.Range("A" & lRow).Copy For i = 1 To 30 ' 2 lines below you are pasting to cell "E5" don't you mean to increment with the row number (i variable) wbTarget.Range("E5").PasteSpecial xlPasteValues wbTarget.Range("E5").PasteSpecial xlPasteColumnWidths ThisWorkbook.Save Application.CutCopyMode = False ' have this line before trying to save a copy of this workbook Application.DisplayAlerts = False ThisWorkbook.SaveCopyAs Filename:=SaveLoc & FName & ".xls" 'FileFormat:=xlNormal Application.DisplayAlerts = True Next i lRow = lRow + 1 Loop Application.ScreenUpdating = True End Sub