View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
stuph[_2_] stuph[_2_] is offline
external usenet poster
 
Posts: 1
Default creating unique new worksheets

Wow! Thanks for such a quick and useful response... after editing thi
a bit, it will do exactly what i need.. thanks again..

Rob van Gelder wrote:
[b]Sub test()
Const cPersonName = 1, cVar1 = 2, cVar2 = 3, cVar3 = 4, cWeek = 5
Dim wksS As Worksheet, wks As Worksheet, i As Long, j As Long,
lngLastRow As Long

Set wksS = Worksheets("Main Data")
lngLastRow = wksS.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lngLastRow
On Error Resume Next
Set wks = Worksheets(wksS.Cells(i, cPersonName).Value)
If Err.Number Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
wks.Name = wksS.Cells(i, cPersonName).Value
wks.Cells(1, cPersonName) = "Person Name"
wks.Cells(1, cVar1) = "Var1"
wks.Cells(1, cVar2) = "Var2"
wks.Cells(1, cVar3) = "Var3"
wks.Cells(1, cWeek) = "Week"
Err.Clear
End If
On Error GoTo 0

j = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
wks.Cells(j, cPersonName) = wksS.Cells(i, cPersonName)
wks.Cells(j, cVar1) = wksS.Cells(i, cVar1)
wks.Cells(j, cVar2) = wksS.Cells(i, cVar2)
wks.Cells(j, cVar3) = wksS.Cells(i, cVar2)
wks.Cells(j, cWeek) = wksS.Cells(i, cWeek)
Next
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/exce


--
Message posted from http://www.ExcelForum.com