仅在PC上抛出1004错误

VBAmacros引发运行时错误“1004”：Range类的PasteSpecial方法失败

macros在PC上运行时，只会引发此错误。 在Mac上，macros无缝运行。 下面的macros有什么理由会抛出一个错误？

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

错误的原因是您过早地将源代码范围复制到剪贴板，并且不知何故，当您尝试将源代码粘贴到相应的工作表的时候剪贴板是空的，因此给出错误1004 。 至于为什么Mac不给出错误，我不知道，可能没有执行L.Copy和.PasteSpecial之间的操作清除剪贴板或任何Mac使用。 不过，在剪贴板中保留要复制的项目是个不好的做法。

我也对你的代码进行了审查，并强调了一些需要改进的地方（见下面的评论）

 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" 

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

应用程序成员（Excel） ， 错误声明 ， DateSerial函数

而… Wend语句 ， Do …循环语句 ， 有声明

 Option Explicit Sub DCR() Dim rSrc As Range 'Source Range to be copied Dim WbkTrg As Workbook 'Target Workbook to act upon Dim sWbkTrg As String 'Target Workbook name Dim WshTrg As Worksheet 'Target Worksheet to act upon Dim sWshTrg As String 'Target Worksheet name Dim bMonth As Byte Dim dDate As Date Dim bDay As Byte Dim b As Byte Rem Application Settings OFF Application.EnableEvents = False Application.DisplayAlerts = False Application.ScreenUpdating = False Rem Get User Input Do On Error Resume Next bMonth = InputBox("Enter month number (1 to 12) or 0 to cancel.") On Error GoTo 0 b = 1 + b If bMonth = 0 Then GoTo ExitTkn If b = 3 Then GoTo ExitTkn Loop Until bMonth >= 1 And bMonth <= 12 Rem Set Target Range To Be Copied Into New Workbook Set rSrc = ThisWorkbook.Sheets("Sheet1").Range("A1:G7") Rem Add Target Workbook Set WbkTrg = Workbooks.Add sWbkTrg = "DCR_" & Format(DateSerial(Year(Now), bMonth, 1), "yyyy-mm") & ".xlsx" Rem Delete All Worksheets Minus One In Target Workbook Do With WbkTrg If .Sheets.Count = 1 Then Exit Do .Sheets(1).Delete End With Loop Rem Add Worksheet for each day of the month For bDay = 1 To 31 Rem Set Date & Month dDate = DateSerial(Year(Now), bMonth, bDay) sWshTrg = Format(dDate, "dddd mm-dd-yyyy") If Month(dDate) = bMonth Then Rem Process Worksheets - Days With WbkTrg If bDay = 1 Then Rem Process 1st Day Set WshTrg = .Sheets(bDay) Else Rem Add Remaining Days Set WshTrg = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End If: End With Rem Update Day Standard Data WshTrg.Name = sWshTrg With WshTrg.Range("A1") rSrc.Copy .PasteSpecial Paste:=xlPasteValues .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteColumnWidths .Value = sWshTrg Application.CutCopyMode = False End With End If: Next Rem Save Target Workbook Application.Goto WbkTrg.Sheets(1).Cells(1), 1 On Error Resume Next Workbooks(sWbkTrg).Close 'Close Workbook If Open On Error GoTo 0 WbkTrg.SaveAs Filename:=sWbkTrg ExitTkn: Rem Application Settings ON Application.EnableEvents = True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub