The first thing I would do for speed is use ***arrays*** for the information you need. So in this case, we create a 10x4 array that has the locomotive, train, beginning row, ending row

    Private Sub MainTrain()
        Dim numberOfTrains As Long
        numberOfTrains = Application.Count(Sheet2.Range("I:I"))
        Dim lastRow As Long
        lastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
        Dim myTrains As Variant
        myTrains = TrainNames(numberOfTrains, lastRow)
       
        Dim myTrainRange As Variant
        myTrainRange = TrainRange(numberOfTrains, lastRow)
       
        Dim trainInformation As Variant
        ReDim trainInformation(1 To numberOfTrains, 1 To 4)
        
        Dim i
        For i = 1 To numberOfTrains
            trainInformation(i, 1) = myTrains(i, 1)
            trainInformation(i, 2) = myTrains(i, 2)
            trainInformation(i, 3) = myTrainRange(i, 1)
            trainInformation(i, 4) = myTrainRange(i, 2)
        Next
        
    End Sub
    
    Private Function TrainNames(ByVal numberOfTrains As Long, ByVal lastRow As Long) As Variant
        Dim myTrains As Variant
        ReDim myTrains(1 To numberOfTrains, 1 To 2)
        Dim trainIndex As Long
        trainIndex = 1
        Dim i As Long
        For i = 1 To lastRow
            If Sheet2.Cells(i, 9) = 1 Then
                myTrains(trainIndex, 1) = Sheet2.Cells(i, 1).Value
                myTrains(trainIndex, 2) = Sheet2.Cells(i, 2).Value
                If trainIndex = numberOfTrains Then Exit For
                trainIndex = trainIndex + 1
            End If
        Next
        TrainNames = myTrains
    End Function
    
    Private Function TrainRange(ByVal numberOfTrains As Long, ByVal lastRow As Long) As Variant
        Dim myTrains As Variant
        ReDim myTrains(1 To numberOfTrains, 1 To 2)
        Dim trainIndex As Long
        trainIndex = 1
        Dim i As Long
        For i = 1 To lastRow
            If Sheet2.Cells(i, 9) = 1 Then
                myTrains(trainIndex, 1) = i
                If trainIndex = numberOfTrains Then Exit For
                trainIndex = trainIndex + 1
            End If
        Next
        trainIndex = 1
        myTrains(1, 1) = 2
        For i = 1 To numberOfTrains - 1
            myTrains(i, 2) = myTrains(i + 1, 1) - 1
        Next
        myTrains(numberOfTrains, 2) = lastRow
        TrainRange = myTrains
    End Function

I split it out into two functions, which means it's slower by needing to loop twice, but it's more clear what's happening. You can adjust as needed. Now you can use this array to lookup the information in the other sheet (hint: bring it into an array) to populate the interpolation.

    Dim trainSchedule As Variant
    trainSchedule = Sheet2.Range("A2:H" & lastRow)

By reading everything into arrays, you don't need to *do* anything on the sheet, which will be incredibly faster.

It also gets rid of those awful formulas on sheet3 finding the rows, if need be you can just use the `trainInformation` to print rows 4 through 7 on sheet3.

    PopulateTrains trainInformation
    Private Sub PopulateTrains(ByVal trainInformation As Variant)
        Dim i As Long
        For i = 1 To UBound(trainInformation)
            Sheet3.Cells(7, i + 2) = trainInformation(i, 1)
            Sheet3.Cells(6, i + 2) = trainInformation(i, 2)
            Sheet3.Cells(4, i + 2) = trainInformation(i, 3)
            Sheet3.Cells(5, i + 2) = trainInformation(i, 4)
        Next
    End Sub

Now you need a function to populate your trainTable array by comparing the trains to the schedule.