Solved: If Cell Value is Worksheet Name Copy Row

[coliervile]

Good evening to everyone :hi: I could use your expertise once again VBA Experts. In the following workbook I need a macro to search worksheet "Registration" column "K" (starting at "K2" down) for the name of other worksheets (e.g. "Team 1") in the workbook. If the worksheet name (e.g. "Team 1") is in column "K" then copy that row's cell values, columns "B" through "J" and paste the cell values in worksheet ("Team 1") starting at row 9 columns "B" through "J" and then sort the data pasted in these columns (range B2:J23) alphabetically from the names in column "B".

Example: There are currently 11 worksheets in this workbook named Team 1, Team 2, Team 3 and so on to Team 10 and one named "Registration". In worksheet "Registration" in column "K" are the names of these 10 other worksheets. I want the macro to search column "K", starting at "K2" down, to see if the names of the 10 teams are present. If Team 1 is in column "K" then copy the cell values in that row from column "B" through column "J" and paste the cell values in worksheet "Team 1" starting a row "B9" through "J9" down and then sort the pasted data by column "B" alphabetically. :dunno Boy I hope I explained that correctly...Whew.
</IMG></IMG>

[mdmackillop]

Option Explicit

Sub MoveData()
Dim Rng As Range
Dim Tgt As Range
Dim cel As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").ClearContents
End If
Next

With Sheets("Registration")
Set Rng = Range(.Cells(2, 11), .Cells(2, 11).End(xlDown))
For Each cel In Rng
Set Tgt = Sheets(cel.Text).Cells(24, 2).End(xlUp).Offset(1)
cel.Offset(, -9).Resize(, 9).Copy Tgt
Next
End With

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With sh.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sh.Activate
sh.Range("A1").Activate
End If
Next

Sheets("Registration").Activate
Application.ScreenUpdating = True
End Sub

[coliervile]

Thanks for replying "mdmackillop" and how are you this evening? I ran your code and ran into a Compile error: Method or data not found... at this location in RED

Sub MoveData()
Dim Rng As Range
Dim Tgt As Range
Dim cel As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").ClearContents
End If
Next

With Sheets("Registration")
Set Rng = Range(.Cells(2, 11), .Cells(2, 11).End(xlDown))
For Each cel In Rng
Set Tgt = Sheets(cel.Text).Cells(24, 2).End(xlUp).Offset(1)
cel.Offset(, -9).Resize(, 9).Copy Tgt
Next
End With

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With sh.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sh.Activate
sh.Range("A1").Activate
End If
Next

Sheets("Registration").Activate
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Hi Charlie,
Record a macro sorting the data and substitute into that section. Probably an Excel version thing. I've come across it before.

[coliervile]

I use Excel 2003 what are you using. I'll try your suggestion and see what I come up with.

[coliervile]

"MD" I took the sort portion For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With sh.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sh.Activate
sh.Range("A1").Activate
End If
Next
out and ran the code and the only thing that copied over to the "Team" sheets were the names in column "B" from the worksheet "Registration"???

[coliervile]

"MD" I got the codeto work. but if I run the code a second time I get another Compile error: Method or data member not found at this location in RED the area in PURPLE is the "sh" change to "Worksheets".

Sub MoveData()
Dim Rng As Range
Dim Tgt As Range
Dim cel As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").ClearContents
End If
Next

With Sheets("Registration")
Set Rng = Range(.Cells(2, 11), .Cells(2, 11).End(xlDown))
For Each cel In Rng
Set Tgt = Sheets(cel.Text).Cells(24, 2).End(xlUp).Offset(1)
cel.Offset(, -9).Resize(, 9).Copy Tgt
Next
End With

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With Worksheets.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sh.Activate
sh.Range("A1").Activate
End If
Next

Sheets("Registration").Activate
Application.ScreenUpdating = True
End Sub

[mdmackillop]

What is your recorded sort macro?

[coliervile]

I had just changed you "sh" you had originally and changed it to "Worksheets" and that did work, but when I ran it a second time the complie error came up,

[mdmackillop]

It would.

[mdmackillop]

Post #8?

[coliervile]

Here's the sort I came up with for "Team 1".

Sub Sorts()
With Sheets("Team 1")
.Range("B9:J23").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlNo _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

I still don't know why this wouldn't work when changed???

I got the code to work, but if I run the code a second time I get another Compile error: Method or data member not found at this location in RED the area in PURPLE is the "sh" change to "Worksheets".

"MD" I got the codeto work. but if I run the code a second time I get another Compile error: Method or data member not found at this location in RED the area in PURPLE is the "sh" change to "Worksheets".





[VBA]
Sub MoveData()
Dim Rng As Range
Dim Tgt As Range
Dim cel As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").ClearContents
End If
Next
With Sheets("Registration")
Set Rng = Range(.Cells(2, 11), .Cells(2, 11).End(xlDown))
For Each cel In Rng
Set Tgt = Sheets(cel.Text).Cells(24, 2).End(xlUp).Offset(1)
cel.Offset(, -9).Resize(, 9).Copy Tgt
Next
End With
For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With Worksheets.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sh.Activate
sh.Range("A1").Activate
End If
Next
Sheets("Registration").Activate
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Try

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
sh.Activate
sh.Range("A1").Activate
End If
Next

[coliervile]

Thanks "MD" for replying. I added the new coding and I'm getting a Copile error: Invalid or unqualified reference at the area in RED:

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
sh.Range("B9:J23").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
sh.Activate
sh.Range("A1").Activate
End If
Next

[mdmackillop]

Try
Key1:=sh.Range("B9"),
or
Key1:=Range("B9"),

[coliervile]

"MD" thank you Sir the Key1:=sh.Range("B9") did the trick. I still would like to know why your originial macro did not work with just using "sh" or "Worksheets"at this location:

For Each sh In Worksheets
If Left(sh.Name, 4) = "Team" Then
With sh.Sort
.SortFields.Add Key:=Range("B9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B9:J23")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

seems as though it should have worked.

[mdmackillop]

This was recorded using Excel 2007; Probably a compatability issue.

[coliervile]

Okay thanks "MD"