run time error '1004'

michaelt23

New Member
Joined
Oct 4, 2006
Messages
13
I have a macro someone else created and has since left the company, and when I try to run it I get this, any suggestions?

Run-time error '1004':

PasteSpecial method of range class failed


Here is a copy of the code where it is erroring at.

Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False



IF you need more of the code let me know.

Thanks,
Michael
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Michael

I think we definitely need to see the rest of the code.

For example what is actually selected when the error occurs.
 
Upvote 0
It would probably be better if you posted it here - that will give everybody a chance to help.:)
 
Upvote 0
Here is the entire code for the module the error is in. I have put 3 # in from of the line that is having trouble.

Sub ASRManExcReport()
' Project: HSS500BPRT.PRT Report Manipulation
' Macro: ASRManExcReport
' Company: Fleetwood Homes Central Region Service Center
' Date: Macro recorded 9/30/2004 by Fleetwood Associate
' Programmer: Jason Leidig
' Description: Creates management exception report
'Keyboard Shortcut: N/A
'
Dim intManCellsCol As Integer
Dim intManCellsRow As Integer
Dim strWkBkName As String
Dim strWkBkLocation As String
Dim intStrNumber As Integer
Dim strNewName As String
Dim datDayOldDate As Date
Dim strMEROpenWorkbook As String

'Determine if the "ASR78.xls" is open, if it is open will notify user
'via a message box and will quit the macro
strMEROpenWorkbook = "ManExcepReport78.xls"

For Each Workbook In Application.Workbooks
If Workbook.Name = strMEROpenWorkbook Then
Workbook.Activate
ActiveWindow.Close
Exit Sub
End If
Next

'Add sheets and name each sheet
'----------------------------------------------------
Workbooks.Add
strWkBkName = ActiveWorkbook.Name
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets("Sheet16").Select
Sheets("Sheet16").Name = "RO St 1-4"
Sheets("Sheet15").Select
Sheets("Sheet15").Name = "RA St 1-4"
Sheets("Sheet14").Select
Sheets("Sheet14").Name = "RP St 1-4"
Sheets("Sheet13").Select
Sheets("Sheet13").Name = "St 8 No Date"
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "St 8 Schedule Date >1 Day"
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "St 8-1111 Code"
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "St 8-2222 Code"
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "3333 Codes"
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "8888 Codes"
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "9998 Codes"
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "6666 Codes"
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "7777 Codes"
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Over 50's"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "St 5 > 6"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "St 6 > 1"
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "St 7 > 7"

'Save new workbook as ManExcepReport78.xls
Windows("ASR78.xls").Activate
strWkBkLocation = ActiveWorkbook.FullName

Windows(strWkBkName).Activate
intStrNumber = Len(strWkBkLocation)
intStrNumber = intStrNumber - 9
strNewName = Left(strWkBkLocation, intStrNumber) & "ManExcepReport78.xls"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

'------Copy data from the ASR78.xls to the RO St 1-4 tab------
'-----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="1"
Selection.AutoFilter Field:=6, Criteria1:=">=4"
Selection.AutoFilter Field:=2, Criteria1:="=078-*"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Finish copying rest of data to RO St 1-4
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:=">=2", Operator:=xlAnd, _
Criteria2:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

If intManCellsRow > 2 Then
Range(Cells(3, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select

ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsRow = intManCellsRow + 1

Range(Cells(intManCellsRow, 1), Cells(intManCellsRow, 1)).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If

'------Copy data from ASR78.xls and paste to RA St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="A"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RA St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to RP St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="P"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RP St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8 No Date------
'------------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="8"
Selection.AutoFilter Field:=6, Criteria1:=">=15"
Selection.AutoFilter Field:=5, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 No Date").Select
Range("A1").Select
### Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8 Schedule Date >1 Day------
'-------------------------------------------------------------------------
datDayOldDate = Date
datDayOldDate = datDayOldDate - 2

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate
Selection.AutoFilter Field:=4, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 Schedule Date >1 Day").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-1111 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 15

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:="<=8"
Selection.AutoFilter Field:=4, Criteria1:="1111", Operator:=xlOr _
, Criteria2:="3311"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-1111 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-2222 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 8

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="2222", Operator:=xlOr _
, Criteria2:="3322"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-2222 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 3333 Codes------
'----------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 14

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=4, Criteria1:=">=3300", Operator:=xlAnd, _
Criteria2:="<=3399"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("3333 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 8888 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="8888", Operator:=xlOr _
, Criteria2:="3388"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("8888 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 9998 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="9998", Operator:=xlOr _
, Criteria2:="3398"
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6, Criteria1:=">=2"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("9998 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 6666 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="6666"
Selection.AutoFilter Field:=6

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("6666 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 7777 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="7777"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("7777 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'-----Copy data from ASR78.xls and paste to Over 50's------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7, Criteria1:=">50"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("Over 50's").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 5 > 6------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=7"
Selection.AutoFilter Field:=7
Selection.AutoFilter Field:=8, Criteria1:="5"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 5 > 6").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 6 > 1------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">1"
Selection.AutoFilter Field:=8, Criteria1:="6"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 6 > 1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 7 > 7------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=8"
Selection.AutoFilter Field:=8, Criteria1:="7"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 7 > 7").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Remove criteria from autofilters and close ASR.xls
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=2
Range("A1").Select

End Sub
 
Upvote 0
Here is the entire code for the module the error is in. I have put 3 # in from of the line that is having trouble.

Sub ASRManExcReport()
' Project: HSS500BPRT.PRT Report Manipulation
' Macro: ASRManExcReport
' Company: Fleetwood Homes Central Region Service Center
' Date: Macro recorded 9/30/2004 by Fleetwood Associate
' Programmer: Jason Leidig
' Description: Creates management exception report
'Keyboard Shortcut: N/A
'
Dim intManCellsCol As Integer
Dim intManCellsRow As Integer
Dim strWkBkName As String
Dim strWkBkLocation As String
Dim intStrNumber As Integer
Dim strNewName As String
Dim datDayOldDate As Date
Dim strMEROpenWorkbook As String

'Determine if the "ASR78.xls" is open, if it is open will notify user
'via a message box and will quit the macro
strMEROpenWorkbook = "ManExcepReport78.xls"

For Each Workbook In Application.Workbooks
If Workbook.Name = strMEROpenWorkbook Then
Workbook.Activate
ActiveWindow.Close
Exit Sub
End If
Next

'Add sheets and name each sheet
'----------------------------------------------------
Workbooks.Add
strWkBkName = ActiveWorkbook.Name
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets("Sheet16").Select
Sheets("Sheet16").Name = "RO St 1-4"
Sheets("Sheet15").Select
Sheets("Sheet15").Name = "RA St 1-4"
Sheets("Sheet14").Select
Sheets("Sheet14").Name = "RP St 1-4"
Sheets("Sheet13").Select
Sheets("Sheet13").Name = "St 8 No Date"
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "St 8 Schedule Date >1 Day"
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "St 8-1111 Code"
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "St 8-2222 Code"
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "3333 Codes"
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "8888 Codes"
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "9998 Codes"
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "6666 Codes"
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "7777 Codes"
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Over 50's"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "St 5 > 6"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "St 6 > 1"
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "St 7 > 7"

'Save new workbook as ManExcepReport78.xls
Windows("ASR78.xls").Activate
strWkBkLocation = ActiveWorkbook.FullName

Windows(strWkBkName).Activate
intStrNumber = Len(strWkBkLocation)
intStrNumber = intStrNumber - 9
strNewName = Left(strWkBkLocation, intStrNumber) & "ManExcepReport78.xls"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

'------Copy data from the ASR78.xls to the RO St 1-4 tab------
'-----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="1"
Selection.AutoFilter Field:=6, Criteria1:=">=4"
Selection.AutoFilter Field:=2, Criteria1:="=078-*"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Finish copying rest of data to RO St 1-4
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:=">=2", Operator:=xlAnd, _
Criteria2:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

If intManCellsRow > 2 Then
Range(Cells(3, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select

ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsRow = intManCellsRow + 1

Range(Cells(intManCellsRow, 1), Cells(intManCellsRow, 1)).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If

'------Copy data from ASR78.xls and paste to RA St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="A"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RA St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to RP St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="P"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RP St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8 No Date------
'------------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="8"
Selection.AutoFilter Field:=6, Criteria1:=">=15"
Selection.AutoFilter Field:=5, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 No Date").Select
Range("A1").Select
### Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8 Schedule Date >1 Day------
'-------------------------------------------------------------------------
datDayOldDate = Date
datDayOldDate = datDayOldDate - 2

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate
Selection.AutoFilter Field:=4, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 Schedule Date >1 Day").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-1111 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 15

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:="<=8"
Selection.AutoFilter Field:=4, Criteria1:="1111", Operator:=xlOr _
, Criteria2:="3311"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-1111 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-2222 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 8

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="2222", Operator:=xlOr _
, Criteria2:="3322"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-2222 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 3333 Codes------
'----------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 14

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=4, Criteria1:=">=3300", Operator:=xlAnd, _
Criteria2:="<=3399"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("3333 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 8888 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="8888", Operator:=xlOr _
, Criteria2:="3388"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("8888 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 9998 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="9998", Operator:=xlOr _
, Criteria2:="3398"
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6, Criteria1:=">=2"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("9998 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 6666 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="6666"
Selection.AutoFilter Field:=6

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("6666 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 7777 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="7777"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("7777 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'-----Copy data from ASR78.xls and paste to Over 50's------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7, Criteria1:=">50"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("Over 50's").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 5 > 6------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=7"
Selection.AutoFilter Field:=7
Selection.AutoFilter Field:=8, Criteria1:="5"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 5 > 6").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 6 > 1------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">1"
Selection.AutoFilter Field:=8, Criteria1:="6"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 6 > 1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 7 > 7------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=8"
Selection.AutoFilter Field:=8, Criteria1:="7"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 7 > 7").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Remove criteria from autofilters and close ASR.xls
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=2
Range("A1").Select

End Sub
 
Upvote 0
Michael

Thanks for posting that.:)

I'm just going off now but I'll take a look at it later.

By the way I think you accidentaly double posted.

Could you possibly edit one of the posts?

ie just go in and delete the message text

Is this is the offending section of code?
Code:
 Windows("ManExcepReport78.xls").Activate
Sheets("St 8 No Date").Select
Range("A1").Select
### Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
If it is, see if this helps.
Code:
Workbooks("ManExcepReport78.xls").Sheets("St 8 No Date").Range("A1").PasteSpecial Paste:=xlPasteAllExceptBorders
Note I removed the activate/select, which are normally unneeded.

There's quite a lot of selecting/activating in the code that can be removed.
 
Upvote 0
I still get the same error in the same spot. I had someone on another site tell me to put

msgbox Selection.address

Right before the error and it is returning a msg of $A$2:$S$390 if that helps.
 
Upvote 0
This seem to run ok, hope this helps. I had to add 2 extra sheets.add to run on the excel Im using, but I took them back out of the code. Dan


Sub ASRManExcReport()
' Project: HSS500BPRT.PRT Report Manipulation
' Macro: ASRManExcReport
' Company: Fleetwood Homes Central Region Service Center
' Date: Macro recorded 9/30/2004 by Fleetwood Associate
' Programmer: Jason Leidig
' Description: Creates management exception report
'Keyboard Shortcut: N/A
'
Dim intManCellsCol As Integer
Dim intManCellsRow As Integer
Dim strWkBkName As String
Dim strWkBkLocation As String
Dim intStrNumber As Integer
Dim strNewName As String
Dim datDayOldDate As Date
Dim strMEROpenWorkbook As String

'Determine if the "ASR78.xls" is open, if it is open will notify user
'via a message box and will quit the macro
strMEROpenWorkbook = "ManExcepReport78.xls"

For Each Workbook In Application.Workbooks
If Workbook.Name = strMEROpenWorkbook Then
Workbook.Activate
ActiveWindow.Close
Exit Sub
End If
Next

'Add sheets and name each sheet
'----------------------------------------------------
Workbooks.Add
strWkBkName = ActiveWorkbook.Name
'Sheets.Add
'Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets.Add
Sheets("Sheet16").Select
Sheets("Sheet16").Name = "RO St 1-4"
Sheets("Sheet15").Select
Sheets("Sheet15").Name = "RA St 1-4"
Sheets("Sheet14").Select
Sheets("Sheet14").Name = "RP St 1-4"
Sheets("Sheet13").Select
Sheets("Sheet13").Name = "St 8 No Date"
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "St 8 Schedule Date >1 Day"
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "St 8-1111 Code"
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "St 8-2222 Code"
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "3333 Codes"
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "8888 Codes"
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "9998 Codes"
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "6666 Codes"
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "7777 Codes"
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Over 50's"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "St 5 > 6"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "St 6 > 1"
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "St 7 > 7"

'Save new workbook as ManExcepReport78.xls
Windows("ASR78.xls").Activate
strWkBkLocation = ActiveWorkbook.FullName

Windows(strWkBkName).Activate
intStrNumber = Len(strWkBkLocation)
intStrNumber = intStrNumber - 9
strNewName = Left(strWkBkLocation, intStrNumber) & "ManExcepReport78.xls"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

'------Copy data from the ASR78.xls to the RO St 1-4 tab------
'-----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="1"
Selection.AutoFilter Field:=6, Criteria1:=">=4"
Selection.AutoFilter Field:=2, Criteria1:="=078-*"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Finish copying rest of data to RO St 1-4
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:=">=2", Operator:=xlAnd, _
Criteria2:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

If intManCellsRow > 2 Then
Range(Cells(3, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data to new workbook tab RO St 1-4
Windows("ManExcepReport78.xls").Activate
Sheets("RO St 1-4").Select

ActiveCell.SpecialCells(xlLastCell).Select
intManCellsRow = ActiveCell.Row
intManCellsRow = intManCellsRow + 1

Range(Cells(intManCellsRow, 1), Cells(intManCellsRow, 1)).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If

'------Copy data from ASR78.xls and paste to RA St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="A"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RA St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to RP St 1-4------
'---------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="P"
Selection.AutoFilter Field:=8, Criteria1:="<=4"
Selection.AutoFilter Field:=6, Criteria1:=">=3"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

'Paste data into ManExcepReport78.xls
Windows("ManExcepReport78.xls").Activate
Sheets("RP St 1-4").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8 No Date------
'------------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9, Criteria1:="O"
Selection.AutoFilter Field:=8, Criteria1:="8"
Selection.AutoFilter Field:=6, Criteria1:=">=15"
Selection.AutoFilter Field:=5, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 No Date").Select
Range("A1").Select


Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone,
'SkipBlanks:=False, Transpose:=False





'------Copy data from ASR78.xls and paste to St 8 Schedule Date >1 Day------
'-------------------------------------------------------------------------
datDayOldDate = Date
datDayOldDate = datDayOldDate - 2

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate
Selection.AutoFilter Field:=4, Criteria1:="="

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8 Schedule Date >1 Day").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-1111 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 15

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8, Criteria1:="<=8"
Selection.AutoFilter Field:=4, Criteria1:="1111", Operator:=xlOr _
, Criteria2:="3311"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-1111 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 8-2222 Code------
'--------------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 8

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="2222", Operator:=xlOr _
, Criteria2:="3322"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 8-2222 Code").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 3333 Codes------
'----------------------------------------------------------
datDayOldDate = 0
datDayOldDate = Date
datDayOldDate = datDayOldDate - 14

Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=4, Criteria1:=">=3300", Operator:=xlAnd, _
Criteria2:="<=3399"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("3333 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 8888 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="8888", Operator:=xlOr _
, Criteria2:="3388"
Selection.AutoFilter Field:=5, Criteria1:="<=" & datDayOldDate

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("8888 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 9998 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="9998", Operator:=xlOr _
, Criteria2:="3398"
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6, Criteria1:=">=2"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("9998 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 6666 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="6666"
Selection.AutoFilter Field:=6

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("6666 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to 7777 Codes------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4, Criteria1:="7777"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("7777 Codes").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'-----Copy data from ASR78.xls and paste to Over 50's------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7, Criteria1:=">50"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("Over 50's").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 5 > 6------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=7"
Selection.AutoFilter Field:=7
Selection.AutoFilter Field:=8, Criteria1:="5"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 5 > 6").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 6 > 1------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">1"
Selection.AutoFilter Field:=8, Criteria1:="6"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 6 > 1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'------Copy data from ASR78.xls and paste to St 7 > 7------
'----------------------------------------------------------
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=6, Criteria1:=">=8"
Selection.AutoFilter Field:=8, Criteria1:="7"

'Find last cell of data and copy data in filtered spreadsheet
ActiveCell.SpecialCells(xlLastCell).Select

intManCellsRow = ActiveCell.Row
intManCellsCol = ActiveCell.Column

Range(Cells(2, 1), Cells(intManCellsRow, intManCellsCol)).Select
Selection.Copy

Windows("ManExcepReport78.xls").Activate
Sheets("St 7 > 7").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Remove criteria from autofilters and close ASR.xls
Windows("ASR78.xls").Activate
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=2
Range("A1").Select

End Sub
 
Upvote 0
Michael

I've had a chance to have a closer look at the code, and the first thing I can tell you is that it could do with a serious revamp.

For example the initial part, creating the workbook, then adding and naming the worksheeets could be reduced to this.
Code:
'Add sheets and name each sheet
'----------------------------------------------------
Set wbNew = Workbooks.Add

arrSheets = Array("RO St 1-4", "RA St 1-4", "RP St 1-4", "St 8 No Date", _
                  "St 8 Schedule Date >1 Day", "St 8-1111 Code", "St 8-2222 Code", _
                  "3333 Codes", "8888 Codes", "9998 Codes", "6666 Codes", "7777 Codes", _
                  "Over 50's", "St 5 > 6", "St 6 > 1", "St 7 > 7")

For I = LBound(arrSheets) To UBound(arrSheets)
    wbNew.Sheets.Add
    ActiveSheet.Name = arrSheets(I)
Next I
In fact you could eliminate adding the sheets by creating a template with them in already and then creating the workbook based on that template.
Code:
Set wbNew = Workbooks.Add("C:\MyTemplate.xlt")
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

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