Throwing 1004 Error Only On PC - vba

Question

VBA macro throwing Run-time error '1004':
PasteSpecial method of Range class failed
This error is only being thrown when the macro runs on PC. On a Mac, the macro runs seamlessly. Is there any reason the below macro would throw an error?
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

The reason for the error is that you are prematurely copying the source range to the clipboard, and somehow by the time when you try to paste the source range to the corresponding worksheet the clipboard is empty thus giving the error 1004. As to why the Mac does not give an error I have no idea, probably none of the actions performed between the L.Copy and the .PasteSpecial clears the clipboard or whatever the Mac uses. Nevertheless, it’s a bad practice to keep the items to be copied that long in the clipboard.
I have also done a review of your code and highlighted some points for improvement (see comments below)
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"
This is the revised code.
For a deeper understanding of the resources used suggest to visit these pages:
Application Members (Excel),
On Error Statement,
DateSerial Function
While...Wend Statement,
Do...Loop Statement,
With Statement
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