Excelマクロで手動登録したマクロを下の行までループさせる方法

Question

Selection.Cut
Windows("Book2").Activate
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range(Cells(2, 1)).Select
Selection.Cut
Windows("Book2").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("C1").Select
Selection.Cut
Windows("Book2").Activate
Range("C1").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("D1").Select
Selection.Cut
Windows("Book2").Activate
Range("D1").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("A2").Select
Selection.Cut
Windows("Book2").Activate
Range("E1").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("A3").Select
Selection.Cut
Windows("Book2").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("B3").Select
Selection.Cut
Windows("Book2").Activate
Range("B2").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("C3").Select
Selection.Cut
Windows("Book2").Activate
Range("C2").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("D3").Select
Selection.Cut
Windows("Book2").Activate
Range("D2").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("A4").Select
Selection.Cut
Windows("Book2").Activate
Range("E2").Select
ActiveSheet.Paste
Range("A3").Select
Windows("Book1.xlsx").Activate
Range("A5").Select
Selection.Cut
Windows("Book2").Activate
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("B5").Select
Selection.Cut
Windows("Book2").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("C5").Select
Selection.Cut
Windows("Book2").Activate
Range("C3").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("D5").Select
Selection.Cut
Windows("Book2").Activate
Range("D3").Select
ActiveSheet.Paste
Windows("Book1.xlsx").Activate
Range("A6").Select
Selection.Cut
Windows("Book2").Activate
Range("E3").Select
ActiveSheet.Paste
Range("A4").Select
Windows("Book1.xlsx").Activate
Range("A7").Select

Book1に、表になっていない情報があります。
これをBook2に表にする為にマクロを使って2500行を並び変える方法を知りたいです。

Book1のエクセルは

名前 年齢 生まれた県 今住んでいる県 出身校 性別
名字
名前 年齢 生まれた県 今住んでいる県 出身校 性別
名字
名前 年齢 生まれた県 今住んでいる県 出身校 性別
名字

と言う様な感じで、2500人分入っています。
これをBook2に

名字 名前 年齢 生まれた県 今住んでいる県 出身校 性別
名字 名前 年齢 生まれた県 今住んでいる県 出身校 性別
名字 名前 年齢 生まれた県 今住んでいる県 出身校 性別

という風に横1列に並んだ表にしたいです。

これを実現する為のマクロを教えて頂きたいです。
手動入力で作ったマクロは上部に書いたマクロです。
これを2500人分ループさせて行く方法を教えて頂きたいです。

宜しくお願いします。

Answer 1

VBAを使わなくてもできそうですが、使うならこんな感じでしょうか。

    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    
    Dim iReadRow As Integer
    Dim iWriteRow As Integer
    Dim iCol As Integer
    
    Set sht1 = Sheets("Sheet1")     '読取シート
    Set sht2 = Sheets("Sheet2")     '出力シート
    
    iReadRow = 1
    iWriteRow = 1
    
    'ループ処理
    Do
        '読取行A列が未入力ならループを抜ける
        If sht1.Cells(iReadRow, 1) = "" Then Exit Do
        
        For iCol = 1 To 7
            If iCol = 1 Then
                '出力先A列には読取行の次行A列（苗字）をセット
                sht2.Cells(iWriteRow, iCol) = sht1.Cells(iReadRow + 1, 1)
            Else
                '出力先B列以降には読取行のA列以降をセット
                sht2.Cells(iWriteRow, iCol) = sht1.Cells(iReadRow, iCol - 1)
            End If
        Next
        '次の行
        iReadRow = iReadRow + 2     '読取行を2行進める
        iWriteRow = iWriteRow + 1   '出力行を1行進める
    Loop

（追記）
サンプルコードはシート1⇒シート２へのコピーで作っていますが、ブック１⇒ブック２と読み替えていただいても問題ないはずです。

あと、掲示いただいたコードは質問文のルールとはちょっと違う並びになりそうな気がするのですが・・・。
（動かして確認はしていませんが、B列からB列にコピーしているように見えます。）

Comments

[SmartBuzz]

教えて頂いたコードを実際に使ってみると
Set sht1 = Sheets("Sheet1") '読取シート
この部分で、「型が一致しません」というエラーがでます…。

あと、掲示いただいたコードは質問文のルールとはちょっと違う並びになりそうな気がするのですが・・・。
（動かして確認はしていませんが、B列からB列にコピーしているように見えます。）
＞これについては、Excelのマクロの記録で「Ctrl+X」で順番に貼り付けていく様な形でマクロを作ろうとしていましたので、コピーしている動作があるんだと思います…。

[jawa]

sht1,2の宣言がWorksheet"s"型になってしまっていました。
Worksheet型の誤りですので修正させていただきました。

あと、並びが違いそうという部分ですが、具体的には
```
Windows("Book1.xlsx").Activate
Range("C1").Select
Selection.Cut
Windows("Book2").Activate
Range("C1").Select
ActiveSheet.Paste
```
などで、Book1のC列列をコピー⇒Book2のC列に貼り付けしているように思います。
先頭に苗字が入るので、貼り付け先（Book2）はB列以降、１つずつずらして貼り付けることになると思っていましたので。

[SmartBuzz]

ありがとうございます！
無事できました。

Worksheet型…。
上の宣言のところでしたか…。
デバックしてエラーが出たところを色々いじっていました。

ありがとうございました！勉強になりました！