VBAマクロは

Question

は、私は複数のワークシートを持っている参照テーブルに値に基づいて複数のワークシートをコピー＆ペースト製品。エージェントAのための例：

>  Sales 
>  Name | Product | Sales 
>  A | XX | $100 
>  B | XX | $200 
>  
>  Expense 
>  Name | Product | Sales 
>  A | XX | $10 
>  B | XX | $10 
>  
>  
>  Sales 
>  Name | Product | Sales 
>  A | YY | $400 
>  C | YY | $150 
>  
>  Expense 
>  Name | Product | Sales 
>  A | YY | $80 
>  C | YY | $15 

私は問題にVBAと私の最初のステップを習得しようとしているautofiltered使用して作業コピー＆ペースト機能を持つことです。ここに私のコードは、これまでのところです： ます。Sub Test（）

Dim ws As Worksheet 
Set ws = ThisWorkbook.Worksheets("Sales") 
ws.Rows(1).AutoFilter Field:=1, Criteria1:="A" 
ws.Rows(1).AutoFilter Field:=2, Criteria1:="XX" 
ws.Range("A2:C2", Range("A2:C2").End(xlDown)).Copy 
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial 

Dim ws2 As Worksheet 
Set ws2 = ThisWorkbook.Worksheets("Expense") 
ws2.Rows(1).AutoFilter Field:=1, Criteria1:="A" 
ws2.Rows(1).AutoFilter Field:=2, Criteria1:="XX" 
ws2.Range("A2:C2", Range("A2:C2").End(xlDown)).Copy 
ThisWorkbook.Worksheets("Sheet2").Range("H1").PasteSpecial 

End Sub 

それは、ランタイムエラー1004を返した - オブジェクトの範囲の方法が失敗しました。

しかし、私は販売テーブルだけを貼り付けてコピーすれば、コードは機能しました。

VBAがクリップボード上のデータを削除する可能性がある箇所を見ましたが、salesテーブルが貼り付けられているため、2番目にエラーが出る理由はわかりません。

すべてのヘルプ/アイデアを評価してください。あなたの次のコード行で

Answer 1

：

ws2.Range("A2:C2", ws2.Range("A2:C2").End(xlDown)).Copy 

コピーし、以下の完全なコード：Rangeはシートの参照が不足している

ws2.Range("A2:C2", Range("A2:C2").End(xlDown)).Copy 

、あなたはこのように、WS2を追加する必要があります、エラーは発生しません（アップロードしたサンプルデータで私のPCでテスト済み）

Sub TestCopyPaste() 

Dim ws As Worksheet 
Set ws = ThisWorkbook.Worksheets("Sales") 

ws.Rows(1).AutoFilter Field:=1, Criteria1:="A" 
ws.Rows(1).AutoFilter Field:=2, Criteria1:="XX" 
ws.Range("A2:C2", ws.Range("A2:C2").End(xlDown)).Copy 
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial 

Dim ws2 As Worksheet 
Set ws2 = ThisWorkbook.Worksheets("Expense") 

ws2.Rows(1).AutoFilter Field:=1, Criteria1:="A" 
ws2.Rows(1).AutoFilter Field:=2, Criteria1:="XX" 
ws2.Range("A2:C2", ws2.Range("A2:C2").End(xlDown)).Copy 
ThisWorkbook.Worksheets("Sheet2").Range("H1").PasteSpecial 

End Sub 

Answer 2

名前と製品ではない製品をグループ化しようとしているため、Field:=1というフィルタはコメントアウトしました。

Sub TestCopyPaste() 
    Dim NextRow As Long, x As Long 
    Dim Name As String, Product As String 
    Dim dict As Object 

    Set dict = CreateObject("Scripting.Dictionary") 

    Dim ExpenseRange As Range 

    Worksheets("Report").Cells.Clear 

    For x = 2 To Worksheets("Sales").Range("A" & Rows.Count).End(xlUp).Row 
     Name = Worksheets("Sales").Cells(x, 1) 
     Product = Worksheets("Sales").Cells(x, 2) 

     If Not dict.Exists(Product) Then 
      NextRow = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row 
      If NextRow > 1 Then NextRow = NextRow + 2 

      getFilteredData(Worksheets("Sales"), Name, Product).Copy Worksheets("Report").Cells(NextRow, 1) 

      Set ExpenseRange = getFilteredData(Worksheets("Expense"), Name, Product) 

      If Not ExpenseRange Is Nothing Then 
       NextRow = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 2 
       ExpenseRange.Copy Worksheets("Report").Cells(NextRow, 1) 
      End If 

      dict.Add Product, vbNullString 
     End If 
    Next 

    Worksheets("Report").Columns.AutoFit 

End Sub 

Function getFilteredData(ws As Worksheet, Name As String, Product As String) 
    With ws 
     '.Rows(1).AutoFilter Field:=1, Criteria1:=Name 
     .Rows(1).AutoFilter Field:=2, Criteria1:=Product 
     Set getFilteredData = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible) 
    End With 
End Function