I need VBA code to copy data from grid schedules to teams worksheets

[Legacy 420921]

I want put NFL grid schedule into teams worksheets. look at worksheet Teams by division. I want a vba code on the button is on worksheet that is called Put schedule into teams worksheet.

GET PICTURES HERE IS ZIP
https://1drv.ms/u/s!AnJwxxiz0Ezpg8c5giTqpAFxNZfW7g


GET FILE HERE
https://1drv.ms/x/s!AnJwxxiz0Ezpg8c2yeK7fwWYYZRlLA

Thanks You

Thomas

 

[Michael M]

Sorry, I don't download zip files !!

 

[Legacy 420921]

Get updated file
https://1drv.ms/x/s!AnJwxxiz0Ezpg8dF8HyqCbYElYY9NA?e=L59Kff

TEAMS BY DIVISION picture 1
https://1drv.ms/u/s!AnJwxxiz0Ezpg8dKpFWcy9WXhBhGew


NFL GRID SCHEDULES picture 2
https://1drv.ms/u/s!AnJwxxiz0Ezpg8dLaKnNh9phKenbkw

BUFFALO BILLS picture 3
https://1drv.ms/u/s!AnJwxxiz0Ezpg8dMQRhD7km9SGPPmw

BUTTONS picture 4
https://1drv.ms/u/s!AnJwxxiz0Ezpg8dNCe1boslWb3tU8w

Thank You

Thomas

 

[NoSparks]

I need VBA code to copy data from grid schedules to teams worksheets

This should do that

Sub SchedToTeamSheets()
    
    Dim cel As Range, fndRng As Range
    Dim teamSht As Worksheet, teamName As String

For Each cel In Sheets("NFL GRID SCHEDULES").Range("B1:AG1")
    'the team sheet is the full name
    With Sheets("TEAMS BY DIVISION").UsedRange
        Set fndRng = .Find(What:=cel.Value, _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, _
                           MatchCase:=False)
        teamName = fndRng.Offset(, 1).Value
        Set teamSht = Sheets(teamName)
    End With
    'copy cells to team sheet
    teamSht.Cells(1, "C").Resize(18).Value = cel.Offset(1).Resize(18).Value
Next cel
End Sub

 

[Legacy 420921]

This should do that

Sub SchedToTeamSheets()
    
    Dim cel As Range, fndRng As Range
    Dim teamSht As Worksheet, teamName As String

For Each cel In Sheets("NFL GRID SCHEDULES").Range("B1:AG1")
    'the team sheet is the full name
    With Sheets("TEAMS BY DIVISION").UsedRange
        Set fndRng = .Find(What:=cel.Value, _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, _
                           MatchCase:=False)
        teamName = fndRng.Offset(, 1).Value
        Set teamSht = Sheets(teamName)
    End With
    'copy cells to team sheet
    teamSht.Cells(1, "C").Resize(18).Value = cel.Offset(1).Resize(18).Value
Next cel
End Sub

Thanks You. I will put code on tomorrow and check it out.

 

[Legacy 420921]

I have problem than I pres button stay PUT SCHEDULE INTO TEAMS WORKSHEETS

run-time error '91': Object varible or with block variable not set
teamName = fndRng.Offset(, 1).Value

Private Sub SCHEDULES_TO_TEAMS_SHEETS_Click() Dim cel As Range, fndRng As Range
    Dim teamSht As Worksheet, teamName As String


For Each cel In Sheets("NFL GRID SCHEDULES").Range("B1:AG1")
    'the team sheet is the full name
    With Sheets("TEAMS BY DIVISION").UsedRange
        Set fndRng = .Find(What:=cel.Value, _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, _
                           MatchCase:=False)
        teamName = fndRng.Offset(, 1).Value
        Set teamSht = Sheets(teamName)
    End With
    'copy cells to team sheet
    teamSht.Cells(1, "C").Resize(18).Value = cel.Offset(1).Resize(18).Value
Next cel
End Sub

https://1drv.ms/x/s!AnJwxxiz0Ezpg8dhF4Q7MORL98Zj8Q?e=XDirnW


Thanks You

Thomas

 

[NoSparks]

Team name abbreviations on NFL GRID SCHEDULES row one aren't all the same as TEAMS BY DIVISION abbreviations.

 

[Legacy 420921]

How I change @JAX TO @JAC & @WSH TO WAS

try using finding replace say That function isn't vaild


Thanks you

Thomas

 

[NoSparks]

try this

Sub Change_Abbrev()
Dim cel As Range
For Each cel In Sheets("NFL GRID SCHEDULES").UsedRange
    cel.Value = Replace(Replace(cel.Value, "JAX", "JAC"), "WSH", "WAS")
Next cel
End Sub