Изменить код в макросе, чтобы он в столбце T., делал следующие если к примеру в ячейке T20, T25 стоит текст, то он повторял этот текст на ячейку Т21, Т22 и т.д до ячейки Т24, затем от ячейки T25, то такой же заполненной ячейки. При условии, если в столбце A на этом листе напротив в строке не заполнены ячейки, то текст не заполнять. Сам макрос который нужно изменить                             Sub CopyDataByLinks4()
    Dim wsData As Worksheet
    Dim wsList1 As Worksheet
    
    Set wsData = ThisWorkbook.Worksheets("Данные")
    Set wsList1 = ThisWorkbook.Worksheets("Лист1")
    
    Dim rngLinks As Range
    Dim rngDates As Range
    
    Set rngLinks = wsData.Range("K1", wsData.Cells(wsData.Rows.Count, "K").End(xlUp))
    Set rngDates = wsData.Range("G1", wsData.Cells(wsData.Rows.Count, "G").End(xlUp))
    
    Dim linkCell As Range
    Dim dateCell As Range
    Dim currDate As Variant
    Dim wb As Workbook
    Dim wsRuptures As Worksheet
    Dim rngToCopy As Range
    Dim lastRow As Long
    
    Application.ScreenUpdating = False
    
    For Each linkCell In rngLinks
        If linkCell.Value <> "" Then
            Set wb = Workbooks.Open(linkCell.Value)
            Set wsRuptures = wb.Worksheets("Руптюры склада")
            
            For Each dateCell In rngDates
                If dateCell.Value <> "" Then
                    currDate = Format(dateCell.Value, "dd.mm.yyyy")
                    
                    With wsRuptures.UsedRange
                        .AutoFilter Field:=5, Criteria1:="015"
                        .AutoFilter Field:=19, Criteria1:=currDate
                    End With
                    
                    Set rngToCopy = wsRuptures.Range("C4:U50000").SpecialCells(xlCellTypeVisible)
                    
                    rngToCopy.Copy
                    lastRow = wsList1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).row
                    wsList1.Cells(lastRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
                    
                    ' Add book name to column T
                    wsList1.Range("T" & lastRow & ":T" & lastRow + rngToCopy.Rows.Count - 1).Value = wb.Name
                    
                    wsRuptures.AutoFilterMode = False
                End If
            Next dateCell
            
            wb.Close SaveChanges:=False
        End If
    Next linkCell

    ' Remove values from column T if column A is empty
    Dim i As Long
    For i = wsList1.Cells(wsList1.Rows.Count, "A").End(xlUp).row To 1 Step -1
        If IsEmpty(wsList1.Cells(i, "A")) And Not IsEmpty(wsList1.Cells(i, "T")) Then
            wsList1.Cells(i, "T").ClearContents
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    Dim savedCalcMode As XlCalculation
Dim savedScreenUpdating As Boolean
Dim savedEnableEvents As Boolean
Dim savedEnableAnimations As Boolean

savedCalcMode = Application.Calculation
savedScreenUpdating = Application.ScreenUpdating
savedEnableEvents = Application.EnableEvents
savedEnableAnimations = Application.EnableAnimations

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.EnableAnimations = False

With ActiveSheet
    ActiveSheet.Range("$A$1:$T$90093").AutoFilter Field:=1, Criteria1:="="
    Columns("T:T").Select
    Selection.ClearContents
    Range("I1329").Select
ActiveSheet.Range("$A$1:$T$90093").AutoFilter Field:=1
    Range("M14").Select
End With

Application.Calculation = savedCalcMode
Application.ScreenUpdating = savedScreenUpdating
Application.EnableEvents = savedEnableEvents
Application.EnableAnimations = savedEnableAnimations

End Sub