P
pickytweety
On line 70 (as noted below), it's telling me I need an object. Can you tell
me how to give it one?
Sub PrepareReport()
Dim wksLoc As Worksheet
Dim wksTemp As Worksheet
Dim wksNew As Worksheet
Dim deptCell As Range
Dim deptLoop As Range
Dim strCell As Range
Dim strLoop As Range
Set wksLoc = Sheets("Locations")
Set wksTemp = Sheets("Template")
'Select the list of depts
With wksLoc
Set deptLoop = .Range("c1", .Range("c1").End(xlDown))
End With
'Select the list of stores
With wksLoc
Set strLoop = .Range("a2", .Range("a2").End(xlDown))
End With
'Loop through each dept and str
For Each deptCell In deptLoop
With wksTemp
.Range("a8").Value = deptCell
dept = .Range("a8").Value
End With
For Each strCell In strLoop
With wksTemp
.Range("a5").Value = strCell
.Calculate
End With
'Create a new sheet for each dept
wksTemp.Copy Before:=wksTemp
Set wksNew = ActiveSheet
With wksNew
.Name = Trim(dept)
'Replace formulas with values
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
'Paste the next store
CopyNext wksTemp
Next strCell
Next deptCell
End Sub
Sub CopyNext(wks As Worksheet)
Dim rngfill As Range
With wksTemp
'.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
wks.Rows("8:20").Copy
End With
With wksNew
Set rngfill = Nothing
Set rngfill = .Range("b" & .Rows.Count).End(xlUp) 'IT'S ASKING ME FOR
AN OBJECT HERE.
Set rngfill = rngfill.Offset(2, -1)
rngfill.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
rngfill.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub
me how to give it one?
Sub PrepareReport()
Dim wksLoc As Worksheet
Dim wksTemp As Worksheet
Dim wksNew As Worksheet
Dim deptCell As Range
Dim deptLoop As Range
Dim strCell As Range
Dim strLoop As Range
Set wksLoc = Sheets("Locations")
Set wksTemp = Sheets("Template")
'Select the list of depts
With wksLoc
Set deptLoop = .Range("c1", .Range("c1").End(xlDown))
End With
'Select the list of stores
With wksLoc
Set strLoop = .Range("a2", .Range("a2").End(xlDown))
End With
'Loop through each dept and str
For Each deptCell In deptLoop
With wksTemp
.Range("a8").Value = deptCell
dept = .Range("a8").Value
End With
For Each strCell In strLoop
With wksTemp
.Range("a5").Value = strCell
.Calculate
End With
'Create a new sheet for each dept
wksTemp.Copy Before:=wksTemp
Set wksNew = ActiveSheet
With wksNew
.Name = Trim(dept)
'Replace formulas with values
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
'Paste the next store
CopyNext wksTemp
Next strCell
Next deptCell
End Sub
Sub CopyNext(wks As Worksheet)
Dim rngfill As Range
With wksTemp
'.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
wks.Rows("8:20").Copy
End With
With wksNew
Set rngfill = Nothing
Set rngfill = .Range("b" & .Rows.Count).End(xlUp) 'IT'S ASKING ME FOR
AN OBJECT HERE.
Set rngfill = rngfill.Offset(2, -1)
rngfill.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
rngfill.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub