Run-time Error 1004: PasteSpecial Method of Range Class Failed

Papa_Don

New Member
Joined
Jan 22, 2015
Messages
38
Group,

I've written a macro to copy a part of a row from one workbook into another. This macro has run for many hours without fail (it's moved data from 14,400 workbooks so far). Unfortunately it is stopping on one specific workbook and I can't figure out why. Here's the code I've written:

Sub GetSTRData()

For rowNo = 2 To 500
propNo = Sheets("Property Data").Cells(rowNo, 2).Value
region = Sheets("Property Data").Cells(rowNo, 14).Value
If Not propNo > 0 Then
Exit Sub
End If
If region = "CA" Then
sCurrency = "CAD"
sCountry = "NON US "
Else
sCurrency = "USD"
sCountry = "US "
End If

For iYear = 2011 To 2015
sYear = iYear
For iMonth = 1 To 12
If iMonth < 10 Then
sMonth = "0" & iMonth
End If
If iMonth > 9 Then
sMonth = iMonth
End If
If iMonth = 1 Then
sMName = "January"
End If
If iMonth = 2 Then
sMName = "February"
End If
If iMonth = 3 Then
sMName = "March"
End If
If iMonth = 4 Then
sMName = "April"
End If
If iMonth = 5 Then
sMName = "May"
End If
If iMonth = 6 Then
sMName = "June"
End If
If iMonth = 7 Then
sMName = "July"
End If
If iMonth = 8 Then
sMName = "August"
End If
If iMonth = 9 Then
sMName = "September"
End If
If iMonth = 10 Then
sMName = "October"
End If
If iMonth = 11 Then
sMName = "November"
End If
If iMonth = 12 Then
sMName = "December"
End If

histPath = "O:\Smith Travel Reports (STR)\Monthly STR Reports\" & sCountry & sYear & "\" & sMonth & " " & sMName & "\" & propNo & "-" & sYear & sMonth & "00" & "-" & sCurrency & "-E.xls"""
openFileName = propNo & "-" & sYear & sMonth & "00" & "-" & sCurrency & "-E.xls"
fileDateVal = DateValue(sMonth & "/1/" & sYear)

' Finding PIN and Matching Date on DATA tab

For pinRow = 2 To 2000000
pinNo = Workbooks("STR Data Import.xlsm").Sheets("DATA").Cells(pinRow, 1).Value
dateVal = Workbooks("STR Data Import.xlsm").Sheets("DATA").Cells(pinRow, 2).Value
If pinNo = propNo And dateVal = fileDateVal Then
pasteRow = pinRow
Exit For
End If
Next pinRow

If Dir(histPath) <> "" Then
Workbooks.Open Filename:=histPath
' Get historical Data
' Occupancy Data (getting OCC%)
Windows(openFileName).Activate
sheetCount = ActiveWorkbook.Worksheets.Count
exists = False
For sheetNo = 1 To sheetCount
If ActiveWorkbook.Worksheets(sheetNo).Name = "Daily by Month" Then
exists = True
End If
Next sheetNo
If exists = True Then
Sheets("Daily by Month").Activate
Range("C26:AG26").Activate
If srow = "02" Then
Range("C26:AE26").Activate
End If
If srow = "04" Then
Range("C26:AF26").Activate
End If
If srow = "06" Then
Range("C26:AF26").Activate
End If
If srow = "09" Then
Range("C26:AF26").Activate
End If
If srow = "11" Then
Range("C26:AF26").Activate
End If
Selection.Copy
BPastePoint = "C" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(BPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.0"

' Occupancy Data (getting Compset OCC%)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C27:AG27").Activate
If srow = "02" Then
Range("C27:AE27").Activate
End If
If srow = "04" Then
Range("C27:AF27").Activate
End If
If srow = "06" Then
Range("C27:AF27").Activate
End If
If srow = "09" Then
Range("C27:AF27").Activate
End If
If srow = "11" Then
Range("C27:AF27").Activate
End If
Selection.Copy
BPastePoint = "D" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(BPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.0"

' ADR Data (getting ADR)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C36:AG36").Activate
If srow = "02" Then
Range("C36:AE36").Activate
End If
If srow = "04" Then
Range("C36:AF36").Activate
End If
If srow = "06" Then
Range("C36:AF36").Activate
End If
If srow = "09" Then
Range("C36:AF36").Activate
End If
If srow = "11" Then
Range("C36:AF36").Activate
End If
Selection.Copy
CPastePoint = "E" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(CPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"

' ADR Data (getting Compset ADR)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C37:AG37").Activate
If srow = "02" Then
Range("C37:AE37").Activate
End If
If srow = "04" Then
Range("C37:AF37").Activate
End If
If srow = "06" Then
Range("C37:AF37").Activate
End If
If srow = "09" Then
Range("C37:AF37").Activate
End If
If srow = "11" Then
Range("C37:AF37").Activate
End If
Selection.Copy
CPastePoint = "F" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(CPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"

' RevPar Data (getting RevPar)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C46:AG46").Activate
If srow = "02" Then
Range("C46:AE46").Activate
End If
If srow = "04" Then
Range("C46:AF46").Activate
End If
If srow = "06" Then
Range("C46:AF46").Activate
End If
If srow = "09" Then
Range("C46:AF46").Activate
End If
If srow = "11" Then
Range("C46:AF46").Activate
End If
Selection.Copy
DPastePoint = "G" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(DPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"

' RevPar Data (getting Compset RevPar)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C47:AG47").Activate
If srow = "02" Then
Range("C47:AE47").Activate
End If
If srow = "04" Then
Range("C47:AF47").Activate
End If
If srow = "06" Then
Range("C47:AF47").Activate
End If
If srow = "09" Then
Range("C47:AF47").Activate
End If
If srow = "11" Then
Range("C47:AF47").Activate
End If
Selection.Copy
DPastePoint = "H" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(DPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"

' RPIPC Data (getting RPIPC)
Windows(openFileName).Activate
Sheets("Daily by Month").Activate
Range("C52:AG52").Activate
If srow = "02" Then
Range("C52:AE52").Activate
End If
If srow = "04" Then
Range("C52:AF52").Activate
End If
If srow = "06" Then
Range("C52:AF52").Activate
End If
If srow = "09" Then
Range("C52:AF52").Activate
End If
If srow = "11" Then
Range("C52:AF52").Activate
End If
Selection.Copy
DPastePoint = "I" & pasteRow
Windows("STR Data Import.xlsm").Activate
Sheets("DATA").Activate
Range(DPastePoint).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"

Windows(openFileName).Activate
Application.DisplayAlerts = False
Workbooks(openFileName).Close True
Application.DisplayAlerts = True
If iYear = 2015 And iMonth = 10 Then
Windows("STR Data Import.xlsm").Activate
ActiveWorkbook.Save
End If
Else
Windows(openFileName).Activate
Application.DisplayAlerts = False
Workbooks(openFileName).Close True
Application.DisplayAlerts = True
Windows("STR Data Import.xlsm").Activate

End If
End If
Next iMonth
Next iYear

Next rowNo
Columns("C:I").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Activate
Windows("STR Data Import.xlsm").Activate
ActiveWorkbook.Save
End Sub


The script is failing at

"Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True"

However it doesn't stop until I get to the April 2013 version of the workbook that is holding the data I need. I suppose there is something different about this workbook. However I can't seem to find what it might be. Any thoughts?

In advance, thanks for your assistance.

Don
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
For pinRow = 2 To 2000000
This could be part of the problem. There are only 1048576 rows available in xl2007 and up versions. Much less than that in previous versions. If the code works for part of the data but falters in the latter part, then it could be because of the row designation, but since there was no specific line of code identified for the error, it is hard to tell. When you get the error message, if you click the 'Debug' button, it will show you the line that it has a problem with. You can also hover your mouse pointer (cursor) over the 'pasteRow' varible to activate the Tool Tip and see if it exceeds the sheet row limit at that point.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top