Creating new sheets (more detailed)

[Todd Huttenstine]

On sheet 1, I have names of people located in range
A7:A55. I have the stats for each person in columns
B through U. Each column contains the name of a different
stat. The name of each stat is located on row 6 (from
columns B to U). Now on sheet 4, in range A5:A17 I have
names of stats. Each stat name will match a stat name
found in row 6 of sheet 1.

I need a code that when run, will look in sheet 1 range
A7:A55, and for each person it finds in this range, will
look at sheet 4 in range A5:A17 and look at each stat
name, then go back to sheet 1 and match that stat name
with the stat in row 6.

When it finds the matching stat name, I need it to pull
the corresponding data and put in
column B range B5:B17 corresponding to the stat in range
A5:A17. I need for it to do this for every stat name in
range A5:A17. After it goes through each stat name in
this range, I need the code to copy sheet 4 and create a
new sheet with the name of the person for the current row
it just completed. I need the code to loop through this
entire procedure until there is no more names in range
A7:A55 of sheet 1. Now if a sheet with the same name is
found in the workbook, I need it to automatically over-
write the sheet in the book.

I hope this is not confusing.


Any help is greatly appreciated.

Todd Huttenstine

 

[Tom Ogilvy]

The following worked for me (if I interpreted you description correctly and
didn't have any typos on the ranges/locations)

Sub AAAAA()
Dim rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim rngStat As Range
Dim res As Variant

With Worksheets("Sheet1")
Set rng = .Range("A7:A55")
Set rngStat = .Range("B6:U6")
End With

With Worksheets("Sheet4")
Set rng1 = .Range("A5:A17")
End With

For Each cell In rng
For Each cell1 In rng1
res = Application.Match(cell1, rngStat, 0)
If Not IsError(res) Then
cell1.Offset(0, 1).Value = rngStat(cell.Row - 5, res).Value
End If
Next
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(cell.Value).Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng1.Parent.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
rng1.Offset(0, 1).ClearContents
Next
End Sub