Question

VBA宏投掷运行时错误'1004'： Range类的PasteSpecial方法失败

只有在PC上运行宏时才会抛出此错误。在Mac上，宏无缝运行。下面的宏有没有理由抛出错误？

Option Explicit
Sub DCR()
Dim J As Integer
Dim K As Integer
Dim L As Range
Dim sDay As String
Dim sMonth As String
Dim sTemp As String
Dim iTarget As Integer
Dim dBasis As Date
Dim Wb As Workbook
Dim Wb2 As Workbook

Set Wb = ThisWorkbook
Set L = Sheets("Sheet1").Range("A1:G7")
L.Copy
For Each Wb2 In Application.Workbooks
Wb2.Activate
Next



iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
            iTarget = Val(InputBox("Numeric month?"))
    If iTarget = 0 Then Exit Sub
Wend
Set Wb2 = Workbooks.Add


Application.ScreenUpdating = False
Application.DisplayAlerts = False
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)

For J = 1 To 31
    sDay = Format((dBasis + J - 1), "dddd mm-dd-yyyy")
    sMonth = Format((dBasis), "yyyy-mm")
    If Month(dBasis + J - 1) = iTarget Then
        If J > Sheets.Count Then
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = sDay
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
        Else
            If Left(Sheets(J).Name, 5) = "Sheet" Then
            Sheets(J).Name = sDay
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
            Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = sDay
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
            End If

        End If
    End If
Next J

For J = 1 To (Sheets.Count - 1)
    For K = J + 1 To Sheets.Count
        If Right(Sheets(J).Name, 10) > _
          Right(Sheets(K).Name, 10) Then
            Sheets(K).Move Before:=Sheets(J)
        End If
    Next K
Next J

Sheets(1).Activate
Application.ScreenUpdating = True
Wb2.SaveAs Filename:="DCR_" + sMonth + ".xlsx"
'
End Sub

Answer 1

错误的原因是您过早地将源范围复制到剪贴板，并且当您尝试将源范围粘贴到相应的工作表时，剪贴板为空，从而产生错误{{1} }。至于为什么Mac没有给出错误我不知道，可能在1004和L.Copy之间执行的操作都没有清除剪贴板或Mac使用的任何内容。然而，在剪贴板中长时间保存要复制的项目是一种不好的做法。

我还对您的代码进行了审核，并强调了一些需要改进的地方（请参阅下面的评论）

.PasteSpecial

这是修改后的代码。为了更深入地了解所使用的资源，建议访问这些页面：

Application Members (Excel)， On Error Statement， DateSerial Function

While...Wend Statement， Do...Loop Statement， With Statement

Set Wb = ThisWorkbook                       'Here you set the Wb variable but is not used at all in the entire procedure
Set L = Sheets("Sheet1").Range("A1:G7")     'Here was an opportunity to use the `Wb` variable instead this line points to whatever workbook is active

'This is the cause of the error: here you copy `A1:G7` to the clipboard (1\2)
L.Copy

'This Loop Through All Open Workbooks Seems To Have No Purpose!
For Each Wb2 In Application.Workbooks
    Wb2.Activate
Next

'This is not efficient, if the user does not enter neither a valid number nor a zero it will go endlessly
'Also suggest to use Do...Loop for the reasons mentioned in the Tip of the page While...Wend Statement (see suggested pages)
iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
            iTarget = Val(InputBox("Numeric month?"))
    If iTarget = 0 Then Exit Sub
Wend

'This way of setting the date is not efficient as it depends on knowing the date format used by the user machine
'Sugest to use instead the DateSerial Function (see suggested pages)
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)

        If J > Sheets.Count Then
            Sheets.Add.Move after:=Sheets(Sheets.Count)

            'These lines are repeated for each "situation" of the sheets (three times)
            ActiveSheet.Name = sDay

            'This is the cause of the error(2\2): here you try to paste from an empty clipboard
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
        Else
            If Left(Sheets(J).Name, 5) = "Sheet" Then
            Sheets(J).Name = sDay
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
            Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = sDay
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteValues
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Wb2.Sheets(J).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Value = sDay
            End If

        End If
    End If
Next J

'This sort is redundant, instead have a more efficient process to add the required worksheets
For J = 1 To (Sheets.Count - 1)
    For K = J + 1 To Sheets.Count
        If Right(Sheets(J).Name, 10) > _
          Right(Sheets(K).Name, 10) Then
            Sheets(K).Move Before:=Sheets(J)
        End If
    Next K
Next J

Sheets(1).Activate
Application.ScreenUpdating = True
'Missed to restate the `Application.DisplayAlerts = True`
'This is very dangerous as the system will not advise when closing a workbook without saving it first.
'And it will result in losing all work done on that workbook!

'This will give an error if by any chance a workbook with same name is open
Wb2.SaveAs Filename:="DCR_" + sMonth + ".xlsx"

仅在PC上投掷1004错误

1 个答案: