Subscript out of range

[Ossian13]

Hi Guys,

im trying to copy rows from one sheet to another based on their rating, Rating is in column E (Long,medium or short) and i have 3 sheets with each name.
I have a list with movies and based on their rating i want the entire row to be copied on the specific sheet.

here is my code.

Sub Lup2()


Dim FilmLength As Integer, Filmrating As String, LastRow As Long, i As Integer, film As Workbook


Application.ScreenUpdating = False




Set film = ActiveWorkbook


LastRow = film.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row


    For i = 2 To LastRow
   ' MsgBox film.Worksheets("Sheet1").Range("D" & i).Value
    If film.Worksheets("Sheet1").Range("D" & i).Value < 150 And film.Worksheets("Sheet1").Range("D" & i) > 99 Then
    film.Worksheets("Sheet1").Range("E" & i).Value = "Medium"
    Else
    
    If film.Worksheets("Sheet1").Range("D" & i).Value < 100 Then
    film.Worksheets("Sheet1").Range("E" & i).Value = "Short"
    Else
    film.Worksheets("Sheet1").Range("E" & i).Value = "Long"
    
    
    End If
    End If
    
    Range("A2").Activate
    Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
    Worksheets(Filmrating).Activate
    
    'ActiveWorkbook.Worksheets(Filmrating).Range("A1").Activate
    Selection.PasteSpecial
    
    Next i
    
Application.ScreenUpdating = True


End Sub

i get the error from the title of the thread and this row is highlighted ,,Worksheets(Filmrating).Activate,,
Do you have any idea how should i fix this?

Thank you and regards,
Ossian

 

[Logit]

.
Place Filmrating in quotes. "Filmrating"

 

[Ossian13]

but that means i have a sheet called Filmrating, and i don't. I only have Sheet1 which contains all the movies, then i have 3 more sheets, Long, Medium and Short.
I tried anyways and i have the same result.

 

[gallen]

Filmrating is declared as a string but never set therefore it is an empty string

 

[mumps]

Assuming that Sheet1 has headers in row 1, try the following:

Sub CopyRows()
    Dim FilmLength As Integer, LastRow As Long, i As Long
    Application.ScreenUpdating = False
    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
     For i = 2 To LastRow
        If Sheets("Sheet1").Range("D" & i).Value < 150 And Sheets("Sheet1").Range("D" & i) > 99 Then
            Sheets("Sheet1").Range("E" & i).Value = "Medium"
        ElseIf Sheets("Sheet1").Range("D" & i).Value < 100 Then
            Sheets("Sheet1").Range("E" & i).Value = "Short"
        Else
            Sheets("Sheet1").Range("E" & i).Value = "Long"
        End If
     Next i
     Sheets("Sheet1").Range("E1:E" & LastRow).AutoFilter Field:=1, Criteria1:="Short"
     Sheets("Sheet1").Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Short").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
     Sheets("Sheet1").Range("E1:E" & LastRow).AutoFilter Field:=1, Criteria1:="Medium"
     Sheets("Sheet1").Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Medium").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
     Sheets("Sheet1").Range("E1:E" & LastRow).AutoFilter Field:=1, Criteria1:="Long"
     Sheets("Sheet1").Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Long").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
     If Sheets("Sheet1").AutoFilterMode = True Then Sheets("Sheet1").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[Ossian13]

yep, that was it, i fixed it now. Thank you all for your time!!

 

[mumps]

Glad to help.