저도 엑셀전문가님들의 도움이 필요합니다.ㅜ

[곽완근]

^^; 같은분은 아니시죠?

     오늘은 몇시간차로 방송관계자분께서 방송편성프로그램과 관련된 엑셀질문을..ㅎㅎ

     어쨋든 첨부 참고해 보세요.

Sub test()
    Dim A()
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("방송편성리스트").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    For Each r In Range("c4:i147")
        If r.Value <> "" Then
            p = r.Column
            X = r.MergeArea.Columns.Count
            y = r.Row
            For i = 1 To X
                ReDim Preserve A(1, n)
                A(0, n) = Cells(3, p + i - 1).Value
                s = VBA.Replace(r.Value, Chr(10), "")
                A(1, n) = s
                n = n + 1
            Next
        End If
    Next
    Worksheets.Add.Name = "방송편성리스트"
    Range("a2").Resize(UBound(A, 2) + 1, 2) = _
        Application.Transpose(A)
    Range("a1:b1") = Array("방송일자", "방영프로그램")
    Columns.AutoFit
    Columns(2).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
End Sub

주간편성.xlsm