Improve code for sending info to multiple sheet

Hi all,

I use this code for sending info to a specific sheet, I'd like to have one code for multiple sheets instead of using code for each each sheet.
Could you improve this code, please?

Sub Tstocc65()
'****start 65
Dim Tstocc As Range, _
        Found   As Variant, _
        NextRow As Long

    Sheets("FCI-65").Range("a55:e64") = "" '55-64
    
    For Each Tstocc In Sheets("MEL").Range("A70:A90")
        With Sheets("FCI-65").Range("D26:G29")
            Set Found = .Find(Trim(Tstocc.Text))
            If Not Found Is Nothing Then
                Sheets("FCI-65").Range("a" & (55 + NextRow)).Value = Tstocc.Value
                Sheets("FCI-65").Range("E" & (55 + NextRow)).Value = Tstocc.offset(0, 1).Value
                NextRow = NextRow + 1
            End If
        End With
    Next Tstocc
'*end 
End Sub

other sheets: FCI-65, FCI-66, FCI-313, FCI-315, ...Chrt8, Chrt9, Chrt11...
Thank you very much for your help.

Try this.

Sub Tstocc65()
'****start 65
Dim Tstocc As Range, _
        Found   As Variant, _
        NextRow As Long
        Dim arrSheets, c As Long
        
        
        arrSheets = Array("FCI-65", "FCI-66", "FCI-313", "FCI-315", "Chrt8", "Chrt9", "Chrt11")
For c = LBound(arrSheets) To UBound(arrSheets)
    Sheets(arrSheets(c)).Range("a55:e64") = "" '55-64
    
    For Each Tstocc In Sheets("MEL").Range("A70:A90")
        With Sheets(arrSheets(c)).Range("D26:G29")
            Set Found = .Find(Trim(Tstocc.Text))
            If Not Found Is Nothing Then
                Sheets(arrSheets(c)).Range("a" & (55 + NextRow)).Value = Tstocc.Value
                Sheets(arrSheets(c)).Range("E" & (55 + NextRow)).Value = Tstocc.Offset(0, 1).Value
                NextRow = NextRow + 1
            End If
        End With
    Next Tstocc
    Next c
'*end
End Sub

Here's my attempt:

Option Explicit
Sub Tstocc65()
    '****start 65
    Dim Tstocc As Range, _
        Found As Variant, _
        NextRow As Long, _
        varMySheet As Variant
        
    Application.ScreenUpdating = False
        
    For Each varMySheet In Array("FCI-65", "FCI-66", "FCI-313", "FCI-315", "Chrt8", "Chrt9", "Chrt11")

        Sheets(varMySheet).Range("A55:E64") = "" '55-64
    
        For Each Tstocc In Sheets("MEL").Range("A70:A90")
            With Sheets(varMySheet).Range("D26:G29")
                Set Found = .Find(Trim(Tstocc.Text))
                If Not Found Is Nothing Then
                    Sheets(varMySheet).Range("A" & (55 + NextRow)).Value = Tstocc.Value
                    Sheets(varMySheet).Range("E" & (55 + NextRow)).Value = Tstocc.Offset(0, 1).Value
                    NextRow = NextRow + 1
                End If
            End With
        Next Tstocc
    
    Next varMySheet
    '*end

    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

Hi,
Skywriter, Zbor and Trebor76 thank you very much for your time and help!
I really appreciate!

Hi zbor, all of them!