プロが教えるわが家の防犯対策術!

エクセルVBAで以下のようなコードを書いています。

Sub 工事抽出コピペ()
Dim Obj As Object
With Sheets("工事台帳")
Set Obj = .Range("E5:E65536").Find(.Range("E2"), LookAt:=xlWhole)
If Obj Is Nothing Then
MsgBox "見つかりませんでした。"
Sheets("工事別表示").Range("B11:F65536").ClearContents
Exit Sub
Else
.Range("B6").AutoFilter Field:=4, Criteria1:=.Range("E2").Value
.Range("F5:J" & .Range("B65536").End(xlUp).Row).Copy
End If
End With
Sheets("工事別表示").Range("工事別明細1", "工事別明細2", "工事別明細3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

実行すると、
Sheets("工事別表示").Range("工事別明細1", "工事別明細2", "工事別明細3").PasteSpecial Paste:=xlPasteValues
部分が黄色くなって、

「実行時エラー'450'、引数の数が一致していません。または不正なプロパティを指定しています。」

というエラー表示がでます。

工事台帳シートでオートフィルターをかけ抽出したものが30行あったときに、工事別表示シートは10行ずつの表を作っているので、そこに上から順番にコピペしようとしているのですがうまくいきません。

工事別明細1はB11:F39、工事別明細2はB43:F71、工事別明細3はB75:F103"です。
そもそも、オートフィルターで抽出したものを、分けてペーストすることは可能なのでしょうか?
解決策をおしえてください。
よろしくおねがいします。

A 回答 (3件)

同じデータを3回貼るのではなく、10行ずつにわけて貼るのですよね?


一旦どこかにデータを退避させて10行ずつ貼ったらどうでしょう?
以下は、新たにシートを挿入してデータを一時貼り付け、作業後にシートを削除しています。

Sub 工事抽出コピペ02()
  Dim Obj As Object
  Dim ws As Worksheet
  
  With Sheets("工事台帳")
    Set Obj = .Range("E5:E65536").Find(.Range("E2"), LookAt:=xlWhole)
    If Obj Is Nothing Then
      MsgBox "見つかりませんでした。"
      Sheets("工事別表示").Range("B11:F65536").ClearContents
      Exit Sub
    Else
      Set ws = Sheets.Add
      Range("工事別明細1,工事別明細2,工事別明細3").ClearContents
      .Range("B6").AutoFilter Field:=4, Criteria1:=.Range("E2").Value
      .Range("F5:J" & .Range("B65536").End(xlUp).Row).Copy
    End If
  End With
  
  With ws
    .Range("F1").PasteSpecial Paste:=xlPasteValues
    .Range("F1:J10").Copy
    Range("工事別明細1").Cells(1).PasteSpecial Paste:=xlPasteValues
    .Range("F11:J20").Copy
    Range("工事別明細2").Cells(1).PasteSpecial Paste:=xlPasteValues
    .Range("F21:J30").Copy
    Range("工事別明細3").Cells(1).PasteSpecial Paste:=xlPasteValues
  End With
  Application.DisplayAlerts = False
  ws.Delete
  Application.DisplayAlerts = True
  Application.CutCopyMode = False
End Sub
    • good
    • 0

自分がやりたいことを文章で説明すること。


読者にコードだけ書いて読み解かせるようなことはやらないでほしい。
フィルタ(結果が多数行ある場合で)の結果を、離れた3セル範囲に分けて貼り付けたいのなら、質問のコードは無理だろう。
普通のコピー操作でもそんな事は出来ない経験は無いですか。
一旦作業セル範囲の、行と列を使わないとダメでしょう。

Sub test01()
'Range("a2, b3, D5").Select
'Range("A1").Copy Range("a2, b3, D5")
'Range("A1").Copy Range(n1, n2, n3)
'Range("abc").Select
'Range("abc,abd,abe").Select
'Range("A1").Copy Range("abc, abd, abe")
Range("A1:A3").Copy Range("abc, abd, abe")
End Sub
 はすべてうまく行くようだ(1つだけコメント記号をはずして実行する)
ただしabc、abd、abe は1セルに名前をつけたセル範囲の名前。
ーーーー
Sub test02
Range("A1:A3").Copy Range("xyc, xyd, xye") 'xyc, xyd, xyeはおのおの3セル範囲指定  OK 3->3はOK
Range("A1:A4").Copy Range("xyc, xyd, xye") ''xyc, xyd, xyeはおのおの4セル範囲指定  ERR 3->4はエラ-
End Sub
こういうのをやって試してみれば良い。
    • good
    • 0
この回答へのお礼

みなさま回答をありがとうございました。
教えてくださったのをいろいろ試してみて、うまくいきました。
本当にありがとうございました。
一件一件お礼を書かずにすみません。

お礼日時:2011/06/10 10:13

一例



Sheets("工事別表示").Range("工事別明細1").PasteSpecial Paste:=xlPasteValues
Sheets("工事別表示").Range("工事別明細2").PasteSpecial Paste:=xlPasteValues
Sheets("工事別表示").Range("工事別明細3").PasteSpecial Paste:=xlPasteValues
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!