Macro not correctly moving data

[BigDawg15]

Hello,

Attached are two spreadsheets. The workbook 2017 Work Activity Schedule v1 - Copy is the original workbook I adapted the Macro from.
2017 Work Activity Schedule v1 - Copy.xlsm

The second workbook College Football Helmet Schedule-MR Excel is the one I'm trying to get the Macro CopyData to run correctly.
It should copy the data from Activities worksheet and paste into each of the Division worksheets.
College Football Helmet Schedule-MR Excel.xlsm

I last used this in 2018 and it worked fine. With the corona virus I did not use it for 2019 or 2020. It is pasting data, just not the correct
data to the right team/worksheet.

Any help figuring out what is wrong would be appreciated.

Thank you in advance,

BigDawg15

 

[Fluff]

Ok, your code was trying to copy team 1 to the team 2row, try it like

Sub CopyData()
    Dim r As Range, cel As Range, WS As Worksheet
    Dim Rw&, Col&, Grp$, Nm$
    
On Error Resume Next

    With Sheets("Activities")
        Set r = Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp))
    End With
    For Each cel In r
        If Len(cel) > 3 Then
            Grp = Replace(cel.Offset(, 1), "'", "")
            Set WS = Worksheets(Grp)
            Col = WS.Rows(1).Find(cel.Offset(, -3)).Column
            Rw = WS.Columns(2).Cells.Find(cel.Value, LookAt:=xlWhole).Row
            WS.Cells(Rw, Col).Value = cel.Offset(, 2).Value
           'Ws.Cells(Rw, Col).Interior.ColorIndex = 8 ' Can be deleted
        End If
    Next cel
End Sub

 

[BigDawg15]

Thank you sir. I will give it a shot later this evening.

Thank you again,

BigDawg15

 

[BigDawg15]

Fluff my friend you did it. Seems to be working as expected.
Thank you much for your patience and assistance.

Best regards,

BigDawg15

 

[Fluff]

Glad to help & thanks for the feedback.