| |
▼hint さん：
ありがとうございました。うまくいきました。
お陰様で、すっきりしたステートメントになりました。
小出しで申し訳ないのですが、もう少しお付き合い願えないでしょうか？
ここから先、別のシートに行ってデータを抽出し、また、元のシートへ戻り、挿入した２行の指定の箇所にコピーをする作業をしたいのですが、何もコピーがされないまま終わってしまいます。
現在のステートメントは以下の通りですが、myrange1へ、データを格納したつもりなのですが、それが指定先に反映できないのは、コピーすべき指定先の示し方に問題があるのでしょうか？
Dim myMsg As String
Dim mytitle As String
Dim mycargo As String
Dim myrange As Range
Dim myrange1 As Range
Worksheets("P3").Activate
MsgBox ActiveCell.Value
Set myrange = ActiveCell
'Active cell下に２行挿入
myrange.Offset(1).Resize(2, 1).EntireRow.Insert shift:=xlDown
'挿入された２行に、元のデータcopy (vessel name)
myrange.Offset(0, -1).Copy myrange.Offset(1, -1)
myrange.Offset(0, -1).Copy myrange.Offset(2, -1)
'挿入された２行に、元のデータcopy (Port of Discharge)
myrange.Offset(0, 4).Copy myrange.Offset(1, 4)
myrange.Offset(0, 4).Copy myrange.Offset(2, 4)
'挿入された２行に、元のデータcopy (Port of Loading)
myrange.Offset(0, 5).Copy myrange.Offset(1, 5)
myrange.Offset(0, 5).Copy myrange.Offset(2, 5)
'挿入された２行に、元のデータcopy (QTY)
myrange.Offset(0, 7).Copy myrange.Offset(1, 7)
myrange.Offset(0, 7).Copy myrange.Offset(2, 7)
'CARGO DATAシートのCARGO MODELを選ぶ
Sheets("CARGO DATA").Select
Worksheets("CARGO DATA").Range("B1").Select
Selection.AutoFilter
myMsg = "CARGO MODELを選んで下さい。"
mytitle = "MODEL"
mycargo = Application.InputBox(prompt:=myMsg, Title:=mytitle, Type:=2)
On Error Resume Next
Selection.AutoFilter Field:=1, Criteria1:=mycargo
Sheets("CARGO DATA").Select
Range("B1").Select
Set myrange1 = Range("B2:E2" & [E65536].End(xlUp).Row).SpecialCells(xlCellTypeVisible)
Sheets("CARGO DATA").Select
Selection.AutoFilter
Range("F1").Select
'P3シートに抽出したデータをペースト
Sheets("P3").Select
myrange1.Copy Destination:=Worksheets("P3").myrange.Offset(1)
Range("A1").Select
何度もお手数ですが、どうか宜しくお願いします。
|
|
ushineko
- 12/3/22(木) 15:29 -
