Sub customcopy()

Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long

findWhat = "Committee I "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee I").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next


findWhat = "Committee II "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee II").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee III "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee III").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee IV "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee IV").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee V "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee V").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee VI "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee VI").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee VII "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee VII").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee VIII "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee VIII").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee IX "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee IX").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee X "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee X").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee XI "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee XI").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee XII "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee XII").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee XIII "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee XIII").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee XIV "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee XIV").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

findWhat = "Committee XV "
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("F1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets("Committee XV").Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

i = MsgBox(((j - 1) & " row(s) were copied!"), vbOKOnly, "Result")

Application.ScreenUpdating = True
End Sub