help me revised this vba. copy sheet macro

[Dan88]

hi everyone. I am currently running this macro below that lets me copy a sheet named template to the end and rename it based on a cell value.

Sub End()
Dim ws As Worksheet, wb As Workbook
Dim rngData As Range

Set wb = ActiveWorkbook

With wb.Sheets("Template")
Set rngData = Range(.Range("J2"), .Range("J2").End(xlDown))
End With

For Each cell In rngData
If cell.Value <> "" Then
On Error Resume Next

Set ws = Worksheets(cell.Value)
wb.Sheets("Template").Copy after:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = cell.Value
Else
Set ws = Nothing
End If

On Error GoTo 0
End If
Next cell
End If
End Sub


is there something im missing? the code just wouldn't work. the value in J1 is a date.

thanks in advance.

 

[Weaver]

When you say it won't work, what does it do?

Haven't checked the whole thing but if I was going to name a sheet with a date from a cell, I'd try the following:

wb.Sheets(wb.Sheets.Count).Name = format(cell.Value,"dd_mm_yyyy")

 

[texasalynn]

you can't have "/" in a tab name, so you would need to format the date to something
5-15-2009

 

[Andrew Poulsom]

You haven't said what's not working, but you can't use End as the name of a procedure and your code doesn't compile. Try:

Sub Test()
    Dim ws As Worksheet, wb As Workbook
    Dim rngData As Range
    Dim cell As Range
    Set wb = ActiveWorkbook
    With wb.Sheets("Template")
        Set rngData = Range(.Range("J2"), .Range("J2").End(xlDown))
    End With
    For Each cell In rngData
        If cell.Value <> "" Then
            On Error Resume Next
            Set ws = Worksheets(cell.Value)
            If ws Is Nothing Then
                wb.Sheets("Template").Copy after:=wb.Sheets(wb.Sheets.Count)
                wb.Sheets(wb.Sheets.Count).Name = cell.Value
            Else
                Set ws = Nothing
            End If
            On Error GoTo 0
        End If
    Next cell
End Sub

 

[Dan88]

Thanks!
that worked however, it copies 2 sheets now. One named main(2) and one with cell value(date).

how do i fix this?
is there a way i can have the date appear in alpha numeric (ie. March_01_2009?

thanks

 

[Dan88]

excelR8R/texasalynn/Andrew Poulsom,
i modified the code and it works and i figured out how to get the format to show alpha.
But the macro is copying 2 sheets every time it runs. It makes the sheet and names it after cell j2 and then copies another one.

how do i edit this to get it only to copy 1 sheet?

Thanks

 

[Andrew Poulsom]

Post your code.

 

[Dan88]

Sub copy()
Dim ws As Worksheet, wb As Workbook
Dim rngData As Range
Dim cell As Range
Set wb = ActiveWorkbook
With wb.Sheets("main")
Set rngData = Range(.Range("J2"), .Range("J2").End(xlDown))
End With
For Each cell In rngData
If cell.Value <> "" Then
On Error Resume Next
Set ws = Worksheets(cell.Value)
If ws Is Nothing Then
wb.Sheets("main").copy after:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = Format(cell.Value, "MMM-yy")
Else
Set ws = Nothing
End If

End If
Next
End Sub

 

[texasalynn]

I think you need to change this
wb.Sheets(wb.Sheets.Count).Name = Format(cell.Value, "MMM-yy")
to this
ActiveSheet.Name = Format(cell.Value, "MMM-yy")

 

[Dan88]

texasalynn, thanks AGAIN.
that did the trick!!