|
参考になりますか
コードは下記様にしました。
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
>出来ましたら、他の方も参考になる場合がありますので
>ぐたいてきな(一部でも)こーどがあるとありがたいですが。
|
|