Export data from a source sheet to other sheets in same workbook

[mystie]

Hi to all!

I have a spreadsheet containing around 30 sheets, one sheet for each class and then one sheet Database and one sheet Remarks.

The Database sheet will contain around 7000 records (The exact value will fluctuate). It contains data about students and their performance in all subjects. There will be one entry for each subject the student does.

The classes sheets need to summarise the data from the Database sheet class wise.

So what I need is:
Extract the roll (O3 in class sheet and column D in Database sheet) for each class and fill the corresponding sheets.
Extract the names of the students class wise and fill corresponding sheets (Range B7:B46 in class sheet and column G in Database sheet). It's not necessary that whole B7:B46 is filled as there may be less than 40 students in a class.
Extract the teacher names (range C6:P6 in class sheet and column C in Database sheet)
Extract the marks, grades and ranks for each student subject wise and fill C7:P46, V7:AI7, AM:AZ, respectively (column H, I, J in Database sheet).

I’ve tried to do that using the following code.
However the FindNext part is causing an infinite loop.
Also, I need to do same for all the class sheets and I don’t really know how to do that.
Any help will be most appreciated.

The spreadsheet:
https://www.dropbox.com/s/7fn4923qe1xdztr/Master.xlsm?dl=0

The code:

Sub ExportData()
    Dim shtTD As Worksheet
    Dim shtDB As Worksheet
    Dim Rng As Range
    
    Dim FindClass, Subject, Teacher As String
    Dim Roll, StartCell As Integer
    

    Set shtDB = ThisWorkbook.Worksheets("Database")

    Set shtTD = ThisWorkbook.Worksheets("1 Integrity")

    FindClass = Sheets("1 Integrity").Range("H3").Value
    With Sheets("Database").Range("A:A")
        Set Rng = .Find(What:=FindClass, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
           'Get the roll
           Roll = Rng.Offset(0, 3).Value
           Sheets("1 Integrity").Range("O3").Value = Roll
           
           Call ReadValues(shtTD, shtDB, Rng, Roll)
           
           Do
            Set Rng = .FindNext(After:=Rng.Offset(Roll, 0))
  
            If Not Rng Is Nothing Then
                Call ReadValues(shtTD, shtDB, Rng, Roll)
            Else
                Exit Do
            End If
           Loop
           
        End If
    End With

End Sub
Sub ReadValues(shtTD, shtDB, Rng, Roll)
'Get the Student names
           StartCell = Rng.Row
                         
           FirstCell = 7
           For i = 1 To Roll
               shtTD.Cells(FirstCell, "B").Value = shtDB.Cells(StartCell, "G").Value
                                         
               FirstCell = FirstCell + 1
               StartCell = StartCell + 1
           Next
                
           
           'Get Teacher
           Subject = Rng.Offset(0, 1).Value
           Teacher = Rng.Offset(0, 2).Value
           Select Case Subject
             Case "English"
               Sheets("1 Integrity").Range("C6").Value = Teacher
               
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "C"
                GradesCol = "V"
                RanksCol = "AM"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "French"
               Sheets("1 Truth").Range("D6").Value = Teacher
               
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "D"
                GradesCol = "W"
                RanksCol = "AN"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
             
             Case "Mathematics"
               Sheets("1 Integrity").Range("E6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "E"
                GradesCol = "X"
                RanksCol = "AO"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Int. Science"
               Sheets("1 Integrity").Range("F6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "F"
                GradesCol = "Y"
                RanksCol = "AP"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Home Economics"
               Sheets("1 Integrity").Range("G6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "G"
                GradesCol = "Z"
                RanksCol = "AQ"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Art & Design"
               Sheets("1 Integrity").Range("H6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "H"
                GradesCol = "AA"
                RanksCol = "AR"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Computer Studies"
               Sheets("1 Integrity").Range("I6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "I"
                GradesCol = "AB"
                RanksCol = "AS"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Social Studies"
               Sheets("1 Integrity").Range("J6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "J"
                GradesCol = "AC"
                RanksCol = "AS"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Entrepreneurship"
               Sheets("1 Integrity").Range("K6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "K"
                GradesCol = "AD"
                RanksCol = "AT"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Hindi"
               Sheets("1 Integrity").Range("L6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "L"
                GradesCol = "AE"
                RanksCol = "AU"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Tamil"
               Sheets("1 Integrity").Range("M6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "M"
                GradesCol = "AF"
                RanksCol = "AV"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Telugu"
               Sheets("1 Integrity").Range("N6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "N"
                GradesCol = "AG"
                RanksCol = "AW"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "Urdu"
               Sheets("1 Integrity").Range("O6").Value = Teacher
               'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "O"
                GradesCol = "AH"
                RanksCol = "AX"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
                
             Case "PE"
                Sheets("1 Integrity").Range("P6").Value = Teacher
                'Get the Marks, Grades, Ranks
                StartCell = Rng.Row
                         
                MarksCol = "P"
                GradesCol = "AI"
                RanksCol = "AY"
                Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
           
           End Select
           
           
End Sub
Sub FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
   FirstCell = 7
   For i = 1 To Roll
      shtTD.Cells(FirstCell, MarksCol).Value = shtDB.Cells(StartCell, "H").Value
      shtTD.Cells(FirstCell, GradesCol).Value = shtDB.Cells(StartCell, "J").Value
      shtTD.Cells(FirstCell, RanksCol).Value = shtDB.Cells(StartCell, "I").Value
      FirstCell = FirstCell + 1
      StartCell = StartCell + 1
   Next
End Sub