Paste information in different sheets (would like to specify started at cell A1 in each sheet)

Following from Sid's comment:

Sub data_category()
    Dim y As Long
    Dim x As String, c As Range, ws As Worksheet, wb As Workbook, cDest As Range
    
    Set wb = ActiveWorkbook 'or ThisWorkbook: always good to be specific here
    Set c = wb.Worksheets("sheet1").Range("a3") 'get a reference to the starting cell
    Do Until Len(c.Value) = 0
        
        y = c.Offset(0, 3).Value
        Select Case y               'tidier then if...else if
            Case Is < 90: x = "A"
            Case Is < 120: x = "B"
            Case Else: x = "C"
        End Select
        
        c.Offset(0, 4).Value = x

        'direct copy to next empty row with no select/activate
        Set cDest = wb.Worksheets(x).Cells(Rows.Count, 1).End(xlUp)
        If Len(cDest).Value > 0 Then Set cDest = cDest.Offset(1, 0)
        c.EntireRow.Copy cDest
    
        Set c = c.Offset(1,0) '<<<<<<<<<<<<< edit - added
    Loop
    c.Parent.Activate
End Sub

Rather than the Do-Loop approach, I would do this slightly different for a faster execution.

Logic

1. Find last row in Sheet1 of Col A
2. Insert formula =IF(D3<90,"A",IF(D3<120,"B","C")) in Col E starting at row 3
3. Next I will use autofilter to filter column E on A first and copy all data in one go to Sheet A. I will repeat the process for B and C

My Assumptions

1. Row 2 has headers. If not, tweak the code accordingly.

Code

I have commented the code so you will not have a problem understanding it, but if you do, then simply ask.

Option Explicit

Dim ws As Worksheet
Dim rng As Range

Sub Sample()
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    Dim lRow As Long
    
    With ws
        '~~> Remove any filters
        .AutoFilterMode = False
        
        '~~> Find last row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Insert formula in Col E
        With .Range("E3:E" & lRow)
            .Formula = "=IF(D3<90,""A"",IF(D3<120,""B"",""C""))"
            .Value = .Value
        End With
        
        '~~> Identify the range to work with
        Set rng = .Range("A2:E" & lRow)
        
        '~~> Copy rows with relevant criteria
        CopyData "A"
        CopyData "B"
        CopyData "C"
        
        .AutoFilterMode = False
    End With
End Sub

Private Sub CopyData(shName As String)
    Dim rngToCopy As Range
    
    '~~> Filter column E on the search string
    With rng
        .AutoFilter Field:=5, Criteria1:=shName
        Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
    End With
    
    '~~> Copy all data in one go
    If Not rngToCopy Is Nothing Then rngToCopy.Copy ThisWorkbook.Sheets(shName).Rows(1)
    
    ws.AutoFilterMode = False
End Sub

In Action

Update Category Reports

Option Explicit

Sub UpdateCategoryReports()
    
    Const sfRow As Long = 3 ' First Row (headers are in row 'sfRow - 1')
    Const sfCol As Long = 1
    
    Const dfRow As Long = 2 ' First Row (headers are in row 'dfRow - 1')
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    If slRow < sfRow Then Exit Sub ' no data (highly unlikely)
    
    Dim slCol As Long
    slCol = sws.Cells(sfRow - 1, sws.Columns.Count).End(xlToLeft).Column
    
    Application.ScreenUpdating = False
    
    Dim dws As Worksheet ' Destination Worksheet
    Dim durg As Range ' Destination 'UsedRange'
    Dim dcrg As Range ' Destination Clear Range
    
    ' Clear destination data.
    For Each dws In wb.Worksheets(Array("A", "B", "C"))
        Set durg = dws.UsedRange  ' Destination Used Range
        If durg.Rows.Count > 1 Then
            ' You don't want to clear the headers:
            ' e.g. if 'durg' is 'A1:J10' then 'dcrg' will be 'A2:J10'.
            Set dcrg = durg.Resize(durg.Rows.Count - 1).Offset(1)
            dcrg.Clear
        End If
    Next dws
    
    Dim srrg As Range ' Source Row Range
    Dim sRow As Long ' Source Row
    
    Dim dfCell As Range ' Destination First Cell (Range)
    Dim dRow As Long ' Destination (Available) Row
    Dim sValue As Double ' Source Value
    Dim dwsName As String ' Destination Worksheet Name
    
    For sRow = sfRow To slRow
        
        If IsNumeric(sws.Cells(sRow, "D").Value) Then
            
            sValue = sws.Cells(sRow, "D").Value
            
            If sValue < 90 Then
                dwsName = "A"
            ElseIf sValue < 120 Then
                dwsName = "B"
            Else
                dwsName = "C"
            End If
            
            Set srrg = sws.Range(sws.Cells(sRow, "A"), sws.Cells(sRow, slCol))
            sws.Cells(sRow, "E").Value = dwsName ' ?
            
            Set dws = wb.Worksheets(dwsName)
            dRow = dws.Cells(dws.Rows.Count, "A").End(xlUp).Row + 1
            Set dfCell = dws.Cells(dRow, "A")
            
            ' This will copy values, formats, and formulas. You may need another
            ' way. If there are formulas in source and you only need values,
            ' copying by assignment is the most efficient way. If you also need
            ' the formats you will have to use the least efficient PasteSpecial.
            srrg.Copy Destination:=dfCell
        
        'Else ' sValue is not numeric: do nothing
        End If
        
    Next sRow
 
    'sws.Activate
    'sws.Cells(1).Activate

    Application.ScreenUpdating = True
    
    MsgBox "Category reports updated.", vbInformation, "Category Reports"

End Sub