Perhaps something like this:
Option ExplicitSub SumarizeYears()
Dim lYear As String
Dim lOffSet As Long
Dim sh As Worksheet
Set sh = Sheets("Data") ' <--change to the name of the sheet where the data is.
lYear = InputBox("Please enter the year you want to work with.", "Pick A Year")
'Check that its a valid year
If Len(lYear) = 4 And Not IsNumeric(lYear) Then GoTo InvalidYear
' create a filter with the data from the inputbox
sh.Range("H3").CurrentRegion.AutoFilter Field:=8, Criteria1:=lYear
If WorksheetFunction.CountA(sh.Range("H:H").SpecialCells(xlCellTypeVisible)) Then GoTo CleanUp
' check if there is a sheet with the name of the year
If SheetExists(lYear) = False Then
'Add a new sheet with that name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lYear
'copy titles
sh.Range("A3").Resize(, sh.Range("H3").CurrentRegion.Columns.Count).Copy Destination:=Sheets(lYear).Range("A1")
End If
' Copy the data from the master sheet to the individualsheet
sh.Range("H3").CurrentRegion.Offset(1, 0).Copy
Sheets(lYear).Range("A" & Sheets(lYear).Cells(Rows.Count, "H").End(xlUp).Row + 1).PasteSpecial xlPasteValues
' Delete the rows
sh.Range("H3").CurrentRegion.Offset(1, 0).EntireRow.Delete
' Remove the filter and select first cell
CleanUp:
sh.Range("H3").CurrentRegion.AutoFilter
sh.Select
Range("A1").Select
Exit Sub
InvalidYear:
MsgBox "The yeat enetered is invalid. Please enter a valid year to proceed." & vbCr & _
"This macro will exit now.", vbOKOnly + vbInformation, "Invalid Year"
Exit Sub
End Sub
Function SheetExists(ByVal sName As String) As Boolean
Dim sh As Worksheet
On Error Resume Next
Set sh = Sheets(sName)
If Err.Number = 0 Then SheetExists = True
On Error GoTo 0
End Function
Thanks