| 
    
     |  | ▼dada さん: 
 とりあえずガチガチの固定フォーマットだというコードです。
 
 Sub Sample()
 Dim shn As Variant
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim x As Long
 Dim v(1 To 30, 1 To 4) As Variant
 
 For Each shn In Array("Sheet1", "Sheet2")
 With Sheets(shn)
 For j = 3 To 7 Step 2    '抽出列
 For k = 6 To 10     '抽出行
 i = i + 1      '転記行
 v(i, 1) = .Range("B3").Value  '部署
 v(i, 2) = .Cells(k, "B").Value '費目
 v(i, 3) = .Cells(5, j).Value  '通貨
 v(i, 4) = .Cells(k, j).Value  '金額
 Next
 Next
 End With
 Next
 
 With Sheets("Sheet3")
 .UsedRange.ClearContents
 .Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
 .Select
 End With
 
 MsgBox "転記完了"
 
 End Sub
 
 |  |