粘贴特殊错误-1004 VBA Excel

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

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

Private子命令按钮1\u单击（）
将目标设置为工作表
将wbSource设置为工作表
Dim SaveLoc As字符串
作为字符串的Dim FName
我想我会坚持多久
设置wbSource=图纸（“图纸3”）
设置wbTarget=图纸（“图纸1”）
wbSource.Activate
范围（“A1”）。激活
当ActiveCell.Value“”时执行此操作
多芬特
ActiveCell，收到
对于i=1到30
wbTarget，激活
使用ActiveSheet
wbTarget.Range（“E5”）。选择
Selection.Paste特殊粘贴：=xlPasteColumnWidths
Selection.Paste特殊粘贴：=xlPasteValues
此工作簿。保存
Application.CutCopyMode=False
以
SaveLoc=“H:\Services\Test Output\Term\uux”
FName=范围（“B5”）
ActiveWorkbook.SaveCopyAs文件名：=SaveLoc&FName&“.xls”文件格式：=xlNormal
Application.DisplayAlerts=False
接下来我
wbSource.Select
ActiveCell.Offset（1，0）.激活
环
Application.ScreenUpdating=True
端接头

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

运行时错误1004

请告知如何解决此问题。

---

提前谢谢。

请尝试下面的代码，不要使用

激活

，

活动单元格

，

选择

和

选择

，而是使用完全限定的

范围

和

工作表

对象

代码内部的解释作为注释（还有一些关于代码的问题）

代码

选项显式
私有子命令按钮1_单击（）
将目标设置为工作表
将wbSource设置为工作表
Dim SaveLoc As字符串
作为字符串的Dim FName
暗我一样长，浅我一样长
设置wbSource=图纸（“图纸3”）
设置wbTarget=图纸（“图纸1”）
'SaveLoc字符串永远不会更改，不会更改；t每次在循环内都需要设置
SaveLoc=“H:\Services\Test Output\Term\uux”
“你从来没有在工作表上对范围进行过限定（我猜这里是“Sheet3”
FName=wbTarget.Range（“B5”）.值
Application.ScreenUpdating=False
lRow=1
执行wbSource.Range（“A”&lRow）.Value“”
wbSource.Range（“A”&lRow）.Copy
对于i=1到30
'下面的2行是粘贴到单元格“E5”的，您的意思不是要随行号（i变量）递增吗
wbTarget.Range（“E5”）.Paste特殊XLPaste值
wbTarget.Range（“E5”）.Paste特殊XLPaste列宽
此工作簿。保存
Application.CutCopyMode=False
'在尝试保存此工作簿的副本之前，请先保存此行
Application.DisplayAlerts=False
ThisWorkbook.SaveCopyAs文件名：=SaveLoc&FName&“.xls”文件格式：=xlNormal
Application.DisplayAlerts=True
接下来我
lRow=lRow+1
环
Application.ScreenUpdating=True
端接头

看到这一点，可能有很多原因……您好，谢谢您的编辑。现在它更有意义了。@Roops欢迎您，如果您通过单击我的答案旁边的灰色复选标记（它将变为绿色）解决了错误标记为“answer@”，当我尝试此操作时，它会给我一个错误13，“FName”的类型不匹配“变量。请注意，单元格B5的引用来自作为目标工作表（wbTarget）的Sheet1。请告知。我正在尝试仅在E5单元格的目标工作表中逐个粘贴值。@Roops我已经编辑了

FName

部分，看看它是否适用于您。如果您想在

范围（“E5”）粘贴值”

，为什么i=1到30有第二个循环

？你需要它做什么？
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