| 
    
     |  | すでに、Keinさんから回答があるので、おこがましいのですが、 一応作ってみたので、黙々とループさせています。
 こういうことでしょうか?書き出しは、Sheet1でいいのですよね?
 
 Sub test()
 Dim i As Long, j As Long, t As Long
 Dim p As Long, m As Long
 
 Application.ScreenUpdating = False
 Sheets("Sheet2").Cells.ClearContents
 With Sheets("Sheet1")
 j = 1: p = 1: m = 1
 Do
 For i = 15 To 34 Step 9
 For t = 1 To 3
 If .Cells(i, j + t).Value = "内" Then
 .Cells(i, j + t).Offset(3).Copy
 .Cells(m, p + 1).PasteSpecial
 p = p + 1
 If p > 12 Then m = m + 1: p = 1
 End If
 Next
 Next
 i = 15
 j = j + 3
 If .Cells(i, j + t).Value = "" Then Exit Do
 Loop
 End With
 With Application
 .ScreenUpdating = True
 .CutCopyMode = False
 End With
 End Sub
 
 |  |