以下の表（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
