以下の表（Sheet1）から出荷された日の数量（値の入っているセル）
を取り出し、Sheet2に出力します。

[Sheet1]
　   Ａ    Ｂ    Ｃ   
　┌──┬──┬──┬──┬──┬──┬──┬──┬──┬
１│品番│ 9/1│ 9/2│ 9/3│ 9/4│・・│・・│9/31│合計│
　├──┼──┼──┼──┼──┼──┼──┼──┼──┼
２│A-A │  10│    │  10│    │    │    │    │  20│
　├──┼──┼──┼──┼──┼──┼──┼──┼──┼
３│B-B │    │    │    │    │    │    │    │   0│
　├──┼──┼──┼──┼──┼──┼──┼──┼──┼
４│C-C │    │   5│    │    │    │    │   5│  10│
　├──┼──┼──┼──┼──┼──┼──┼──┼──┼

[Sheet2]
　   Ａ    Ｂ    Ｃ   
　┌──┬──┬──┬
１│    │ 9/1│ 9/3│
　├──┼──┼──┼
２│A-A │  10│  10│
　├──┼──┼──┼
３│    │ 9/2│9/31│
　├──┼──┼──┼
４│C-C │   5│   5│
　├──┼──┼──┼

　サンプルマクロは、上記のような１行目にタイトル、２行目からデータで
最後の列に合計列がある表を想定しています。


Sub GetInputSel()

    Dim nMaxCol As Long     '最大行
    Dim nMaxRow As Long     '最大列
    Dim nCurCol As Long     '処理対象列
    Dim nCurRow As Long     '処理対象行
    
    '合計列を無視してデータの有るセル範囲を選択する
    Worksheets("Sheet1").Select

    nMaxRow = ActiveCell.SpecialCells(xlLastCell).Row
    nMaxCol = ActiveCell.SpecialCells(xlLastCell).Column - 1    '合計行は無視

    '選択したセル範囲をShee2にコピーする
    Worksheets("Sheet1").Range(Cells(1, 1), Cells(nMaxRow, nMaxCol)).Copy
    Worksheets("Sheet2").Cells(1, 1).PasteSpecial

    '１行目（日付行）を一行おきに挿入する
    Worksheets("Sheet2").Select

    nMaxRow = (nMaxRow - 1) * 2

    For nCurRow = 3 To nMaxRow Step 2
        Range(Cells(1, 1), Cells(1, nMaxCol)).Copy
        Range(Cells(nCurRow, 1), Cells(nCurRow, nMaxCol)).Insert Shift:=xlDown
        Cells(nCurRow, 1).ClearContents
    Next nCurRow

    Cells(1, 1).ClearContents

    '値のない日（セル）を左詰削除する
    For nCurRow = 2 To nMaxRow Step 2

        For nCurCol = nMaxCol To 2 Step -1

            If Val(Cells(nCurRow, nCurCol)) <= 0 Then
                Range(Cells(nCurRow - 1, nCurCol), Cells(nCurRow, nCurCol)).Select
                Selection.Delete Shift:=xlToLeft
            End If

        Next nCurCol

    Next nCurRow

    '値のないセルが有る品番（行）は削除する
    For nCurRow = nMaxRow To 2 Step -2

        If Val(Cells(nCurRow, 2)) <= 0 Then
            Range(Cells(nCurRow - 1, 1), Cells(nCurRow, nMaxCol)).Select
            Selection.Delete Shift:=xlUp
        End If

    Next nCurRow

End Sub