jammer6_9
01-05-2012, 06:51 AM
After successfuly creating a number of sheets, code stop and giving "Copy Mode" error on the line (Red Color)? Any idea why?
Sub MakeNewSheets()
MsgBox ("This will take few minutes, do not interrupt the process"), vbInformation, "ofsjcr"
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Please wait while performing task, do not interrupt the process"
Worksheets("Master").Visible = xlSheetVisible
'Application.ScreenUpdating = False
Sheets("MENU ITEMS SUM ").Activate
For Each Cell In Sheets("MENU ITEMS SUM ").Range("J3", Range("J368").End(xlUp))
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
Sheets("Master").Select
Range("P15:Q43").Select
Selection.ClearContents
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
Sheets("Recipe_update").Select
ActiveSheet.Range("$O$5:$O$6000").AutoFilter Field:=14, Criteria1:=Cell _
, Operator:=xlAnd
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
With Range("S:T")
.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''
Sheets("Master").Select
Range("P15:Q43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
If Not SheetExists(Cell.Value) Then
Sheets("Master").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Cell
.Range("B1") = Cell
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Sheets("MENU ITEMS SUM ").Activate
Next
Worksheets("Master").Visible = xlSheetVeryHidden
' Application.ScreenUpdating = True
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Sub MakeNewSheets()
MsgBox ("This will take few minutes, do not interrupt the process"), vbInformation, "ofsjcr"
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Please wait while performing task, do not interrupt the process"
Worksheets("Master").Visible = xlSheetVisible
'Application.ScreenUpdating = False
Sheets("MENU ITEMS SUM ").Activate
For Each Cell In Sheets("MENU ITEMS SUM ").Range("J3", Range("J368").End(xlUp))
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
Sheets("Master").Select
Range("P15:Q43").Select
Selection.ClearContents
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
Sheets("Recipe_update").Select
ActiveSheet.Range("$O$5:$O$6000").AutoFilter Field:=14, Criteria1:=Cell _
, Operator:=xlAnd
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
With Range("S:T")
.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''
Sheets("Master").Select
Range("P15:Q43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
If Not SheetExists(Cell.Value) Then
Sheets("Master").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Cell
.Range("B1") = Cell
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Sheets("MENU ITEMS SUM ").Activate
Next
Worksheets("Master").Visible = xlSheetVeryHidden
' Application.ScreenUpdating = True
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub