VBA Move between sheets

[MacroNobie]

Hi I'm using a code to move between sheets, but when I go back and forth it does not work. Is there a way to use this code better?

Sub abcd()
Dim sht As Worksheet
Dim cell As Range
Dim actWsh As String
Application.ScreenUpdating = False

For Each sht In ThisWorkbook.Worksheets
sht.Activate
shtname = ActiveSheet.Range("B8").Value
If shtname = "FIASP + NovoRapid" Or sht.Name = "Directory" Then
shtname = ActiveSheet.Name
Worksheets(shtname).Shapes("Drp_Dwn").ControlFormat.RemoveAllItems
For Each cell In Range("TerrDrop_101")
With ActiveSheet.Shapes("Drp_Dwn").ControlFormat
.AddItem cell.Value
End With
Next
End If
Next
Sheet1.Activate
End Sub




Sub MovetoSheet()
Dim dd As DropDown


Set dd = ActiveSheet.Shapes("Drp_Dwn").OLEFormat.Object
shtnametogo = dd.List(dd.ListIndex)
'Worksheets(ActiveSheet.Name).Shapes("Drp_Dwn").Value
Worksheets(shtnametogo).Activate
Range("A1").Activate
End Sub

 

[njimack]

Not sure what you mean by "go back and forth", but you don't need to activate sheets to work with them. See if the below helps, if not please be a bit more specific in terms of the problem you're facing.

Sub abcd()
 Dim sht As Worksheet
 Dim cell As Range
 Dim actWsh As String
 Application.ScreenUpdating = False
For Each sht In ThisWorkbook.Worksheets
    With sht
        shtname = .Cells(8, 2).Value
        Select Case shtname
            Case "Directory", "FIASP + NovoRapid"
            .Shapes("Drp_Dwn").ControlFormat.RemoveAllItems
                For Each cell In .Range("TerrDrop_101")
                    .Shapes("Drp_Dwn").ControlFormat.AddItem cell.Value
                Next cell
        End Select
    End With
Next sht
     
 End Sub