Sub fff()
    Dim step&, i&
    Dim iCell As Range, fRng As Range
    
    Sheets("Result").[A1].CurrentRegion.Columns(1).Resize(Sheets("Result").[A1].CurrentRegion.Rows.Count, 15).Clear
    
    step = 1
    For Each iCell In Sheets("List").[A1].CurrentRegion.Columns(1).Cells
        If LCase(iCell.Offset(0, 8)) = "все" Then
            Set fRng = Sheets("Cities").[A1].EntireRow.Find(What:=iCell.Offset(0, 9), LookIn:=xlValues, lookAt:=xlWhole)
            If Not fRng Is Nothing Then
                i = 1
                Do While fRng.Offset(i, 0) <> ""
                    iCell.Resize(1, 15).Copy Sheets("Result").[A1].Offset(step - 1, 0)
                    Sheets("Result").[A1].Offset(step - 1, 8) = fRng.Offset(i, 0)
                    i = i + 1
                    step = step + 1
                Loop
            Else
                iCell.Resize(1, 15).Copy Sheets("Result").[A1].Offset(step - 1, 0)
                step = step + 1
            End If
        Else
            iCell.Resize(1, 15).Copy Sheets("Result").[A1].Offset(step - 1, 0)
            step = step + 1
        End If
    Next
End Sub