Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
複数のシートのフォームをまとめる
投稿日時: 17/06/14 13:12:49
投稿者: シナモン

場所ごとのシートが複数あります。
シートの中身は
 
A1:項目名 場所名、B1:東京、大阪など。。。
A2:項目名 コード、B1:11、22など。。。
 
ここから下が横の表になります。
A3:項目名 データ1、B3:項目名 データ2
A4:A3のデータ、B4:B3のデータ
 
これをAからDの横の表にまとめたいです。
 
A列:場所名(場所ごとのシートのA3のデータがある限りA列に場所名が入る)
B列:コード(場所ごとのシートのA3のデータがある限りB列に場所名が入る)
C列:場所ごとのシートのA3のデータ
D列:場所ごとのシートのB3のデータ
 
どうかご教授ください。
よろしくお願いします。

回答
投稿日時: 17/06/14 13:39:08
投稿者: mattuwan44

たとえばこんな感じでセル位置を指定します。
 
Sub test()
    Dim Rng As Range
    Dim c As Range
    Dim ixRow As Long
     
    'データ範囲の取得
    With Sheets("Sheet1")
        Set Rng = .Range(.Range("A3"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    '新しく書き込むシートの行番号の初期値を設定
    ixRow = 2
     
    '範囲内の各セルを巡回
    With Sheets("Sheet2")
        For Each c In Rng
            '各セルを転記
            .Cells(ixRow, 1).Value = Rng(-1, 1).Value '場所
            .Cells(ixRow, 2).Value = Rng(0, 1).Value '場所コード
            .Cells(ixRow, 3).Value = c.Value '項目1
            .Cells(ixRow, 4).Value = c.Offset(, 1).Value '項目2
             
            '書き込み行番号を+1して次の行番号を用意
            ixRow = ixRow + 1
        Next
    End With
End Sub
 
実際に動かしてないので、バグがあるかもですm(_ _)m

投稿日時: 17/06/14 16:22:06
投稿者: シナモン

mattuwan44さん、大変ありがとうございます。
参考にさせていただき、無事に動きました。