Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        sht.Activate
        If CheckBox10.Value = True Then
        Application.Run "ПоказЯнв"
        Else
        Application.Run "СкрытьЯнв"
        End If
        If CheckBox11.Value = True Then
        Application.Run "ПоказФевр"
        Else
        Application.Run "СкрытьФевр"
        End If
        If CheckBox12.Value = True Then
        Application.Run "ПоказМарт"
        Else
        Application.Run "СкрытьМарт"
        End If
    Next sht

        If arrSrc(i, 16) <> 0 Then
            Set shRes = bkRes.Worksheets(arrSrc(i, 4))
            With shRes
                lr = .Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
                    , SearchFormat:=False).Row + 1
                'Здесь допишите для остальных ячеек по аналогии. Сейчас сделано для двух ячеек.
'               <вот так>
                .Cells(lr, 1).Resize(, 15).Value = shSrc.Cells(i, 2).Resize(, 15).Value
'               <вместо этого всего:>
'                shRes.Cells(lr, "A").Value = shSrc.Cells(i, "B").Value
'                shRes.Cells(lr, "B").Value = shSrc.Cells(i, "C").Value
'                shRes.Cells(lr, "C").Value = shSrc.Cells(i, "D").Value
'                shRes.Cells(lr, "D").Value = shSrc.Cells(i, "E").Value
'                shRes.Cells(lr, "E").Value = shSrc.Cells(i, "F").Value
'                shRes.Cells(lr, "F").Value = shSrc.Cells(i, "G").Value
'                shRes.Cells(lr, "G").Value = shSrc.Cells(i, "H").Value
'                shRes.Cells(lr, "H").Value = shSrc.Cells(i, "I").Value
'                shRes.Cells(lr, "I").Value = shSrc.Cells(i, "J").Value
'                shRes.Cells(lr, "J").Value = shSrc.Cells(i, "K").Value
'                shRes.Cells(lr, "K").Value = shSrc.Cells(i, "L").Value
'                shRes.Cells(lr, "L").Value = shSrc.Cells(i, "M").Value
'                shRes.Cells(lr, "M").Value = shSrc.Cells(i, "N").Value
'                shRes.Cells(lr, "N").Value = shSrc.Cells(i, "O").Value
'                shRes.Cells(lr, "O").Value = shSrc.Cells(i, "P").Value
            End With
        End If

Columns("j").Value = Columns("j").Value

Sub test()
    Dim iPath$, lrow&, arr(), fname$
    Dim sht As Worksheet, i&, j&, k&, l&
    iPath = "Путь" & Application.PathSeparator
    Set sht = ThisWorkbook.Worksheets(1)
    fname = Dir(iPath & "*.xls*")
    Do Until fname = ""
        k = 0
        With GetObject(iPath & fname)
            arr = .ActiveSheet.[a2].CurrentRegion.Value
            .Close False
        End With
        lrow = sht.Range("a" & sht.Rows.Count).End(xlUp).Row + 1
        For i = 3 To UBound(arr)
            If arr(i, 3) > 0 Then
                k = k + 1: l = 0
                For j = 2 To UBound(arr, 2)
                    Select Case j
                        Case 1 To 6, 9, 10, 12 To 18
                            l = l + 1
                            arr(k, l) = arr(i, j)
                    End Select
                Next j
                arr(k, 1) = fname
            End If
        Next i
        sht.Range("a" & lrow).Resize(k, l) = arr
        fname = Dir
    Loop
    sht.[a1].Resize(, 4) = Array("Имя файла", "арт.", "кол-во", "% скидки")
    sht.UsedRange.Columns.AutoFit
End Sub

    Dim arr()
    arr = Array("270", "288", "306", "324", "342", "360", "378", "396", "414", "0", "18", "36", "54", "72", "90", "108", "126", "144", "162", "180", "198", "216", "234", "252")
    MsgBox arr(Hour(Now))
    Med_Chart.lblTimeLine.Left = arr(Hour(Now))

Private Sub UserForm_Click()
    Dim lbl As Control
    Set lbl = Me.Label2
    With lbl
        .Visible = True
        .Top = Me.Label1.Top
        .Left = Me.Label1.Left
        .Width = Me.Label1.Width
        .Height = Me.Label1.Height
        .BorderStyle = 1
        .BorderColor = vbRed
        .BackStyle = 0
    End With
End Sub

Private Sub UserForm_Initialize()
    Me.Label2.Visible = False
End Sub