Multiple runs of VBA code - vba

Question

I have a code that I want to run several times but for now I can run it only once unless I made some changes at data sheet name.
My code:
Public Sub MyFilter()
Dim lngStart As Date, lngEnd As Date
lngStart = Range("b2").Value 'assume this is the start date
lngEnd = Range("b3").Value 'assume this is the end date
Range("q:q").AutoFilter field:=1, _
Criteria1:=">=" & lngStart, _
Operator:=xlAnd, _
Criteria2:="<=" & lngEnd
Range("A1:s3000").Select
Range("A:A").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "FilterData"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Cells.Select
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.AutoFilter
Columns("A:A").EntireColumn.AutoFit
Range("A2").Select
End Sub
Before I execute it I create sheet2 manually but if I want to run it again I cant because I already have "FilterData" sheet data name.
How can I modify the code to:
1. Run it without the need to enter "sheet2" manually.
2. To run it more than once.
Thanks!

Answer 1

When you create a new sheet in Excel it becomes the active sheet, so instead of specifically selecting sheet 2 you can use activesheet
Sheets.Add After:=ActiveSheet
With ActiveSheet
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Columns("A:A").EntireColumn.AutoFit
.Cells.Select
.Cells.EntireColumn.AutoFit
.Rows("1:1").Select
.Application.CutCopyMode = False
With Selection
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.AutoFilter
End With
.Columns("A:A").EntireColumn.AutoFit
.Range("A2").Select
End With
Then you can manually rename all your new sheets.
Alternatively if you want to loop a set number of times you could wrap the whole thing in a loop and increment sheet names:
For i = 1 to 4
Sheets.Add After:=ActiveSheet
With ActiveSheet
.Name = "FilterData " & i
*rest of the code here*
End With
Next i
This will create 4 sheets called FilterData 1, 2, 3 etc, but again this will throw an error if you already have sheets called those things.