粘贴特殊错误 - 1004 VBA Excel

Question

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

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，而是使用完全限定的Ranges和Worksheet对象。

代码中的解释为 cmets（还有一些关于您的代码的问题）。

代码

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