|
すでに、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
|
|