View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Don Guillett Don Guillett is offline
external usenet poster
 
Posts: 10,124
Default Copy and Remame Sheet in active Workbook

Try this from your list on sheet1 starting at a2
Sub findc1()
With Sheets("sheet1")
On Error GoTo nono
For i = .Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
x = .Columns(1).Find(.Cells(i, 1), after:=.Cells(i, 1), _
SearchDirection:=xlPrevious).Row
If x i Then
Sheets.Add.Name = .Cells(i, 1) & "1"
Else
Sheets.Add.Name = .Cells(i, 1)
End If
Next
nono:
End With
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Bjoern" wrote in message
...
Hello and thank you, too.

I will create a sheet for every name out of a list of persons and I will
name the sheets like the Persons. But of cause you are right I have to
include something if two people have the same name. And I thing it will
be inspired by you're code snipe. Happily this part will be easy because
I sort the List before Creating the Sheets ;).

regards
Bjoern

Gord Dibben schrieb:
Just don't run the macro twice or it will error out because you already
have a
sheet named "renamed".

You may want to trap for such an occurence.

Sub copysheetandrename()
Dim n
On Error GoTo trap
n = 1
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "renamed" & n
Exit Sub
trap: If n = "" Then n = 0
n = n + 1
Resume
End Sub


Gord Dibben MS Excel MVP

On Sat, 22 Sep 2007 16:22:07 -0500, "Don Guillett"

wrote:

You could have recorded a manual copy (right click sheet tabcopyetc)
Sub Macro7()
'
' Macro7 Macro
' Macro recorded 9/22/2007 by Donald B. Guillett
'

'
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(23)
Sheets("Sheet20 (2)").Select
Sheets("Sheet20 (2)").Name = "renamed"
End Sub

cleaned up

Sub copysheetandrename()
Sheets("Sheet20").Copy After:=Sheets(sheets.count)
ActiveSheet.Name = "renamed"
End Sub