excel - VBA: Copying Segments of data onto another sheet

First thing, I am a newbie with VBA please be gentle. My code is below the picture and this code has to read Department # and copy everything that comes under the Department # until the next Department # approaches and paste the copied data into an assigned sheet for that Departments.

In this picture, Department 73 starts in (A1:H1) ends at (A30:H30). The next Department start at line 31 and ends at line 37. The thing is that there are 80 departments and each of them has its own sheet. This excel files comes formatted this way. Is it possible to write a macro that can locate Departments # by reading accounts and copies three lines above it and ONLY its own values which are under it until it reaches the next department members
and paste those values into an assigned sheet. Like department 3, department 5.

This code is just brainstorming, I don't exactly know how to code this...Please help if you have experience.

   Sub copyingdata()

   Dim sec1 As Long

   Dim Counter As Integer
   Dim MyString As String


   MyString = "Department 63"
   For i = 1 To Len(MyString)

   sec1 = WorksheetFunction.Match("Department 60", .Columns("A"), 0)
   sec1.Resize(i).Select

   Selection
   Sheets("Sheet1").Selection.Copy Destination:=Sheets("Amanda").Range("A1")
   Sheets("Sheet1").Selection.Copy
   Sheets("Amanda").Activate

   Range("A1").Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   End Sub

Answer

Based on our chat, I believe the following code will split your data into the sheets you have already set up:

Sub AllocateDepartmentData()
    Dim prevRow As Long

    Dim deptRow As Long
    Dim deptNum As Variant
    Dim destSheet As String
    Dim destRow As Long
    prevRow = 0
    'Find the end of the first section
    deptRow = Range("A:A").Find(What:="Department", LookIn:=xlValues, LookAt:=xlPart).Row
    Do While deptRow > prevRow
        'Parse the cell containing the department number/name to get just the number
        deptNum = Cells(deptRow, 1).Value

        deptNum = Mid(deptNum, InStr(deptNum, " ") + 1)
        deptNum = CInt(Left(deptNum, InStr(deptNum & " ", " ") - 1))
        'Based on the department number, determine the destination sheet
        Select Case deptNum
            'One "Case" statement should be set for each destination sheet name
            Case 1, 2, 60, 61, 63
                destSheet = "Amanda"
            'Add more "Case" statements for each sheet
            Case 73, 74
                destSheet = "Shannon"

            'And finally catch any departments that haven't been allocated to a sheet
            Case Else
                MsgBox "Department " & deptNum & " has not been allocated to anyone!"
                End
        End Select
        With Worksheets(destSheet)
            'Work out which row to copy to
            destRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            'destRow will be 2 if the sheet was currently empty, so adjust to be 1 instead
            If destRow = 2 Then destRow = 1

            'Copy everything from the end of the previous section to the end of this section
            Rows((prevRow + 1) & ":" & deptRow).Copy Destination:=.Range("A" & destRow)
        End With
        'Set up for next section
        prevRow = deptRow
        deptRow = Range("A:A").FindNext(Cells(deptRow, "A")).Row
        'The loop will stop once the newly found "Department" is on a row before the last processed section
    Loop
End Sub