| 
    
     |  | 参考になりますか コードは下記様にしました。
 
 Private Sub CommandButton1_Click()
 Dim j As Integer
 Dim Datasu As Integer
 Dim DataSu As Long
 
 ShtName = "△△"
 ShtName1 = "XX"
 Application.ScreenUpdating = False
 
 DataSu = Worksheets(ShtName).Range("B1").Value
 
 For j = 1 To DataSu
 With Worksheets(ShtName1)
 
 .Range("B1").Value = j
 
 .Range("O" & 3 + j).Value = Worksheets(ShtName).Range("BC" & 4 + j).Value
 .Range("P" & 3 + j).Value = Worksheets(ShtName).Range("X" & 4 + j).Value
 .Range("Q" & 3 + j).Value = Worksheets(ShtName).Range("Y" & 4 + j).Value
 .Range("R" & 3 + j).Value = Worksheets(ShtName).Range("AA" & 4 + j).Value
 .Range("S" & 3 + j).Value = Worksheets(ShtName).Range("AB" & 4 + j).Value
 .Range("T" & 3 + j).Value = Worksheets(ShtName).Range("AD" & 4 + j).Value
 .Range("U" & 3 + j).Value = Worksheets(ShtName).Range("AE" & 4 + j).Value
 .Range("V" & 3 + j).Value = Worksheets(ShtName).Range("AG" & 4 + j).Value
 .Range("W" & 3 + j).Value = Worksheets(ShtName).Range("AH" & 4 + j).Value
 
 End With
 Next j
 Worksheets(ShtName1).Activate
 Worksheets(ShtName1).Range("B1").Value = DataSu
 Worksheets(ShtName1).Range("B1").Select
 Application.ScreenUpdating = True
 
 MsgBox "結果一覧の抽出完了"
 
 Exit Sub
 End Sub
 
 >出来ましたら、他の方も参考になる場合がありますので
 >ぐたいてきな(一部でも)こーどがあるとありがたいですが。
 
 |  |