元データを別シートへコピーしてA列の値の変わり目に空白行を挿入等するには?
Question 1307.2 Excel VBA Borad (掲示板)より Previous Next
質問に慣れていなくて申し訳ありません。
やりたいことは左図のとおりでして、

「元データ」シートの内容を「結果」シートにコピーするのですが、
 ・A列の値の変わり目に空白行を挿入し、
 ・挿入した行のB列のセルへ、1つ下の行のA列のセル
  情報をコピーする
というマクロに仕上げたいです。よろしくご指導願います。

こちらのサイトで回答に行ごとの説明文があったのがとっても参考になり、昨日も一つ応用問題が解け助かりました。
Answer   2013.7.31 永井善王
回答が遅くなってしまったので、もう出来てしまいましたか? (別スレッドの解決に大きな工数が必要でした。)
ご自身でマクロをどこまで作れたかが不明ですので、提示された図にに沿って順次進めてみます。

1. 「元データ」を「結果」シートへコピーする … 自動記録すると下記のようなマクロができます。
Sub Macro1()
    Sheets("結果").Select
    Cells.Select
    Selection.Clear
    Sheets("元データ").Select
    Cells.Select
    Selection.Copy
    Sheets("結果").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("12:12").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
End Sub
2. 上記マクロを整理してスッキリさせると下記のようになります。
Sub Macro1s()
    Sheets("結果").Cells.Clear
    Sheets("元データ").Cells.Copy
    Sheets("結果").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
3. 「結果」シートのデータの最下行の行番号を取得するコード
    最下行 = Range("A" & Rows.Count).End(xlUp).Row
4. 最下行から2行目まで反復処理するコード
    最下行 = Range("A" & Rows.Count).End(xlUp).Row
    For 行 = 最下行 To 2 Step -1
        If Range("A" & 行).Value <> Range("A" & 行 - 1).Value Then
        MsgBox 行
        End If
    Next
5. A列の値が変わったかの判断機能を 4. に組み込む
  (A列の値の変わり目で右図のメッセージボックスが表示される)
Sub 最下行から2行目まで反復するコード()
    最下行 = Range("A" & Rows.Count).End(xlUp).Row
    For 行 = 最下行 To 2 Step -1
        If Range("A" & 行).Value <> Range("A" & 行 - 1).Value Then
        MsgBox 行 & "   " & Range("A" & 行).Value
        End If
    Next
End Sub
6. 行を挿入するコードを 5. に追加する
Sub 最下行から2行目まで反復して行を挿入するコード()
    最下行 = Range("A" & Rows.Count).End(xlUp).Row
    For 行 = 最下行 To 2 Step -1
        If Range("A" & 行).Value <> Range("A" & 行 - 1).Value Then
            MsgBox 行 & "   " & Range("A" & 行).Value
            Rows(行).Insert Shift:=xlDown
        End If
    Next
End Sub
回答はここまでとします。(この掲示板では丸投げ質問ご遠慮です。)
1行目に行を挿入するコードと、挿入した行のB列のセルへ直下行のA列のセルの値(右上図のメッセージボックスに表示されている値)をコピーするコードは、ぜひ、ご自分で考え、完成させてください。
どうしても分からないときは、再質問してください。ではガンバ!!
P.S. マクロができたらアップしてください。
(お断り) ここまでのQAはBBSでの2回分のやり取りを編集してあります。
サンプルブックのダウンロードは ここをクリック (YNxv9c7284.xls 44KB)
ありがとうございました
お忙しい中、丁寧なステップ回答ありがとうございます。 ゆっくり・・読み解いていきます。
又、伺う事もあるかと思いますが、丸投げはしたくない・・!と、思っています。 解けた時の快感も十分理解しています。 カンバります。

Excel VBA Macro