Delete Sheets Macro

Hi all!!

I've created a macro which works great within worksheet now, I would like to clean up the trail of sheets it leaves behind i.e. three. So I thought, copy the data I need then ask it to delete the sheet before it creates a new one:

Range("A:B").SpecialCells(xlCellTypeVisible).Copy
ActiveWindow.SelectedSheets.Delete
Sheets.Add
ActiveSheet.Paste

It asks me whether I really want to Delet to which I click yes (is there a way for this pop-up not to appear?) then, I get a Run Time Error '1004', any ideas??

Many thanks,

Phil

Code

Thanks guys added your bit of code and it seems to work, thanks!!

Here's the code I created, sorry if it's a bit lengthy, I've Added >>> where the yellow arrow points to in debug.

Application.DisplayAlerts = False
Sheets("Service Inventory Report").Select
Range("C:C,F:F").Select
Range("F1").Activate
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=CONCATENATE(A:A,"","",B:B)"
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C9770")
Range("C2:C9770").Select
Cells.Select
Range("A1:C15177").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"G1"), Unique:=True
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("G:H").Select
Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("G:H").EntireColumn.AutoFit
Range("G:G,G1").Select
Selection.Font.Bold = False
Range("G1").Select
Selection.Font.Bold = True
Range("G28").Select
Columns("H:H").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 10.29
ActiveWindow.LargeScroll Down:=-1
Range("H1").Select
ActiveCell.FormulaR1C1 = "USers"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "Users"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Columns("A:F").Select
Selection.Delete Shift:=xlToLeft
Range("D26").Select
Range("A:B").SpecialCells(xlCellTypeVisible).Copy
ActiveWindow.SelectedSheets.Delete
Sheets.Add
>>>the yellow arrow points to this line] ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A1").Select
Range("A:B").SpecialCells(xlCellTypeVisible).Copy
ActiveWindow.SelectedSheets.Delete
Sheets.Add
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SelectedSheets.Delete
Sheets("Users Variance").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Selection.Replace What:="Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Count", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Grand", Replacement:="Total", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.DisplayAlerts = True

Nope

Thanks but I'm afraid the same error appears

Thank You Thank You!!

That did the trick, thank you very much for all your help!!

Ooops another question on this?

Hi there!!

I have another question for u kind folks, at 'step' 15 I have the following:

Range("A1:C15177").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _"G1"), Unique:=True

How can I make so that the range is a selection of available cells with data in them, like:
Selection, Selection.End(xlDown)
Selection, Selection.End(xlToRight)

Many many thanks again for any help!!

Philippe

Lost Again - light please?

Hi there!

I'm lost again. Although in the same format, the macro is used on worksheets that vary in the amount of data they contain, this causes errors here:

Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C9770")
Range("C2:C9770").Select
Cells.Select
Range("A1:C15177").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"G1"), Unique:=True
Columns("G:G").Select

How can I get 'Selection.AutoFill Destination:=Range("C2:C9770")' to update C2:C9770 to whatever it is in the worksheet then, use that value for 'Range("C2:C9770").Select' and for 'Range("A1:C15177"). ...'?

Thank you for any help you can provide, many many thanks!!

Phil

Solved but.. .

Thanks again Derk!!!

What is rather odd though is that I don't get any errors on my XP with Excel 2002 but my colleagues who also has Excel 2002 (and my mac with Excel 2004) both get an error on the very last line:

lrow = Range("A65536").End(xlUp).Row
Range("C2").AutoFill Destination:=Range("C2:C" & lrow)
Range("C2:C" & lrow).Select
Cells.Select
Range("A1:C20000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"G1"), Unique:=True
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

How come my XP with Excel 2002 is quite happy with it all and others freak out, is there a setting I must change somewhere?

Cheers,

Philippe

Compatability

Thanks again!!

As always you were correct unfortunately it moved alone to the next issue (if you still have patience with me, wow!!) and stopped at: 'Range("A:B").SpecialCells(xlCellTypeVisible).Copy' in the following:

Dim s As Worksheet
Range("A:B").SpecialCells(xlCellTypeVisible).Copy
Set s = ActiveSheet
Sheets.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
s.Delete
Application.DisplayAlerts = True

Is this also a compatability issue if so, how do I troubleshoot these issues is there a guide that will tell me these things?

Many many many thanks!!

Phil