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 사용하여 작업 복사 및 붙여 넣기 기능을하는 것입니다. 개체의 범위의 방법 실패 - 하위 테스트()

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가 클립 보드의 데이터를 삭제할 수있는 게시물을 보았습니다.하지만 판매 테이블이 붙여 넣어 졌으므로 두 번째 오류가 발생하는 이유가 확실하지 않습니다.

모든 도움말/아이디어에 감사드립니다. 당신의 다음 코드 줄에

Answer 1

:

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

가 Range는 시트 참조 누락, 당신은 다음과 같이 WS2에게를 추가해야합니다

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

복사 아래의 전체 코드를 , 오류가 발생하지 않습니다 (업로드 한 샘플 데이터로 내 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