copy sheet and rename macro

[moossienl]

Hello, I have the following macro:

Sub Macro2()
Dim r As Range
Set r = [a6]
Do Until r = ""
With Sheets("sheet2").Copy(, Worksheets(Worksheets.Count))
ActiveSheet.Name = r
Range("A2").Value = ActiveSheet.Name
End With
Set r = r.Offset(1)
Loop
Endsub


It creates a copy of "sheet2" and renames it to cell A6, A7 etc of the sheet selected when running the macro. Problem When I run the macro for the first time (with a value in A6 and A7) there are no problems When I add something in cell A8 and run it again (or just run the macro again), it doesnt work anymore, because the sheets of A6 and A7 are already created. Deleting all the sheets and running the macro is a solution, but slows down the process. Do you guys have a better solution for my problem? Thx in advance Moossie

 

[taigovinda]

You could add this in (stolen from here http://www.mrexcel.com/forum/showthread.php?t=3228):

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean 
 
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
 
End Function

...and then change your code to be this:

Sub Macro2() 
Dim r As Range 
Set r = [a6] 
Do Until r = "" 
If not WorkSheetExists(r.value) Then
With Sheets("sheet2").Copy(, Worksheets(Worksheets.Count)) 
ActiveSheet.Name = r 
Range("A2").Value = ActiveSheet.Name 
End With 
End If
Set r = r.Offset(1) 
Loop 
End Sub

 

[moossienl]

it works excellent, thank you!