VBA Excel 두 시트의 동적 범위를 하나의 1004 붙여 넣기 오류로 병합

Question

두 개의 서로 다른 스프레드 시트의 데이터를 몇 개의 피벗 테이블에 대한 데이터 원본이되는 데이터로 병합하려고합니다. 두 시트의 레이아웃이 다르므로 첫 번째 시트를 반복하여 열을 찾고 그 아래의 데이터 범위를 복사 한 다음 wDATA 시트에 붙여 넣습니다. 그런 다음 다음 시트로 이동하여 동일한 머리글을 찾은 다음 첫 번째 블록 아래에 붙여 넣습니다. 내가 가장 좋아하는 오류가 발생했습니다. 1004 다른 소유권과 방법을 시도했지만 붙여 넣지 않으므로 여기부터 시작했습니다. Link은 더 큰 비트와 데이터를 가진 파일입니다. 나는 그 깨끗한 것을 약속한다. 어떤 도움?

  For x = 1 To iEndcol 'TOP SECTION OF DATA -FBL5N 
      If InStr(Cells(1, x), "Sold") Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 1), Cells(lEndRowA, 1)) 
      ElseIf Cells(1, x) = "Invoice#" Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 2), Cells(lEndRowA, 2)) 
      ElseIf Cells(1, x) = "Billing Doc" Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 3), Cells(lEndRowA, 3)) 
      ElseIf InStr(Cells(1, x), "Cust Deduction") Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 4), Cells(lEndRowA, 4)) 
      ElseIf Cells(1, x) = "A/R Adjustment" Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 5), Cells(lEndRowA, 5)) 
      ElseIf InStr(Cells(1, x), "Possible Repay") Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 6), Cells(lEndRowA, 6)) 
      ElseIf InStr(Cells(1, x), "Profit") Then 
       Range(Cells(2, x), Cells(lEndRowA, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 7), Cells(lEndRowA, 7)) 
      End If 
     Next 
    End If 
    ' DO NOT REDEFINE lEndrowA until all data is moved 
    ' Fills in data from the second source, wLID 
    If Not wLID Is Nothing Then 
     wLID.Activate 
     lEndRowB = Cells(4650, 1).End(xlUp).Row 
     iEndcol = Cells(1, 1).End(xlToRight).Column 
     For x = 1 To iEndcol 'BOTTOM 
      If InStr(Cells(1, x), "Sold-To") Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 1), Cells(lEndRowA + lEndRowB, 1)) 
      ElseIf Cells(1, x) = "Invoice#" Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 2), Cells(lEndRowA + lEndRowB, 2)) 
      ElseIf Cells(1, x) = "Billing Doc" Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 3), Cells(lEndRowA + lEndRowB, 3)) 
      ElseIf InStr(Cells(1, x), "Cust Deduction") Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 4), Cells(lEndRowA + lEndRowB, 4)) 
      ElseIf Cells(1, x) = "A/R Adjustment" Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 5), Cells(lEndRowA + lEndRowB, 5)) 
      ElseIf InStr(Cells(1, x), "Possible Repay") Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 6), Cells(lEndRowA + lEndRowB, 6)) 
      ElseIf InStr(Cells(1, x), "Profit") Then 
       Range(Cells(2, x), Cells(lEndRowB, x)).Copy _ 
        Destination:=wDATA.Range(Cells(1, 7), Cells(lEndRowA + lEndRowB, 7)) 
      End If 
     Next 
    End If 

Answer 1

문제는이 코드 라인이다 :

wDATA.Range(Cells(1, 1), Cells(lEndRowA + lEndRowB, 1)) 

당신은 Cells 객체를 Range 객체를 자격이 있지만했습니다. 자격이 없으면 ActiveSheet으로 간주됩니다. 대신이 시도 :

wDATA.Range(wDATA.Cells(1, 1), wDATA.Cells(lEndRowA + lEndRowB, 1)) 

Answer 2

당신은 Range 's 및 Cells에 대한 모든 참조를 자격을하지 않는이 코드

1. 에 문제의 수입니다. 따라서 활성 시트를 참조해야합니다. 항상 원하는 것은 아닙니다.
2. 원본 시트에서 수식을 복사하면 계산이 잘못됩니다. 아마 모든 변수가 정의 또는 FBL5N에서 복사 할 때 wData에
3. 귀하의 색인을 설정하지 값 대신
4. 을 복사 할 것은
이 wData로 색인 Line Item Detail에서 복사 잘못된 것
5. (overrights 첫 번째 데이터는
을 설정 헤더를 덮어 여기

는

Option Explicit 

Sub AR_Request_Populate() 
' 
' 
'  WORKING 
'  TODO: Pull in sales info and pricing folder, Finsih off Repay 
' 
' 
'AR_Request_Populate Macro 
' Refreshes Pivot Tables and fills out the AR Request sheet. Ends with copy,paste, special: values. 
' 
' Keyboard Shortcut: None 
' 

    Dim wb As Workbook 
    Dim wFBL5N As Worksheet 
    Dim wLID As Worksheet 
    Dim wDATA As Worksheet 
    Dim ws As Worksheet 

    Dim iEndcol As Integer 
    Dim lEndRowA As Long, lEndRowB As Long 

    Dim i As Integer, j As Integer 
    Dim y As Integer, x As Integer 
    Dim v 

    On Error Resume Next 
    Set wb = ActiveWorkbook 

    Set wLID = wb.Sheets("Line Item Detail") 
    Set wFBL5N = wb.Sheets("FBL5N") 
    If wFBL5N Is Nothing And wLID Is Nothing Then GoTo 102 
    'On Error GoTo 101 
    On Error GoTo 0 

    'Application.ScreenUpdating = False 
    wb.Sheets("wDATA").Visible = True 
    Set wDATA = wb.Sheets("wDATA") 

    ' Let's make a data sheet.... 
    ' DO NOT REDEFINE lEndrowA until all data is moved 
    If Not wFBL5N Is Nothing Then 
     With wFBL5N 
      lEndRowA = .Cells(.Rows.Count, 1).End(xlUp).Row 
      iEndcol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
      wFBL5N.Copy _ 
       after:=wb.Sheets("FBL5N") 
      'Merges Ref. Key 1 into Profit Center 
      For x = 1 To iEndcol 
       If InStr(.Cells(1, x), "Profit") > 0 Then Exit For 
      Next 
      For j = 1 To iEndcol 
       If InStr(.Cells(1, j), "Ref") > 0 And InStr(Cells(1, j), "1") > 0 Then Exit For 
      Next 
      For y = 1 To lEndRowA 
       If IsEmpty(.Cells(y, x)) Then 
        .Cells(y, j).Copy Destination:=.Cells(y, x) 
       End If 
      Next 
      'And we move it... 
      For x = 1 To iEndcol 'TOP SECTION OF DATA -FBL5N 
       If InStr(.Cells(1, x), "Sold") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 1), wDATA.Cells(lEndRowA, 1)) = v 
       ElseIf .Cells(1, x) = "Invoice#" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 2), wDATA.Cells(lEndRowA, 2)) = v 
       ElseIf .Cells(1, x) = "Billing Doc" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 3), wDATA.Cells(lEndRowA, 3)) = v 
       ElseIf InStr(.Cells(1, x), "Cust Deduction") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 4), wDATA.Cells(lEndRowA, 4)) = v 
       ElseIf .Cells(1, x) = "A/R Adjustment" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 5), wDATA.Cells(lEndRowA, 5)) = v 
       ElseIf InStr(.Cells(1, x), "Possible Repay") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 6), wDATA.Cells(lEndRowA, 6)) = v 
       ElseIf InStr(.Cells(1, x), "Profit") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) 
        wDATA.Range(wDATA.Cells(2, 7), wDATA.Cells(lEndRowA, 7)) = v 
       End If 
      Next 
     End With 
    End If 


    ' DO NOT REDEFINE lEndrowA until all data is moved 
    ' Fills in data from the second source, wLID 
    If Not wLID Is Nothing Then 
     'wLID.Activate 
     With wLID 
      lEndRowB = .Cells(.Rows.Count, 1).End(xlUp).Row 
      iEndcol = .Cells(1, 1).End(xlToRight).Column 
      For x = 1 To iEndcol 'BOTTOM 
       If InStr(.Cells(1, x), "Sold-To") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 1), wDATA.Cells(lEndRowA + lEndRowB - 1, 1)) = v 
       ElseIf .Cells(1, x) = "Invoice#" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 2), wDATA.Cells(lEndRowA + lEndRowB - 1, 2)) = v 
       ElseIf .Cells(1, x) = "Billing Doc" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 3), wDATA.Cells(lEndRowA + lEndRowB - 1, 3)) = v 
       ElseIf InStr(.Cells(1, x), "Cust Deduction") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 4), wDATA.Cells(lEndRowA + lEndRowB - 1, 4)) = v 
       ElseIf .Cells(1, x) = "A/R Adjustment" Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 5), wDATA.Cells(lEndRowA + lEndRowB - 1, 5)) = v 
       ElseIf InStr(.Cells(1, x), "Possible Repay") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 6), wDATA.Cells(lEndRowA + lEndRowB - 1, 6)) = v 
       ElseIf InStr(.Cells(1, x), "Profit") Then 
        v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) 
        wDATA.Range(wDATA.Cells(lEndRowA + 1, 7), wDATA.Cells(lEndRowA + lEndRowB - 1, 7)) = v 
       End If 
      Next 
     End With 
    End If 

99 
    'wARadj.Select 
    ' Range("A1:K1").Select 
    MsgBox "All Done", vbOKOnly, "Yup." 

100 
    'wBDwrk.Visible = False 
    'wPCwrk.Visible = False 
    'wDATA.Visible = False 
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
End 

101  '101 and greater are error handlings for specific errors 
    MsgBox "Sorry, there was an error and you might not be able to use this macro. If there are formula errors, delete the formulas and try the macro again. If this wasn't the problem, send a copy of this file and a breif message about what you were doing to me at:" _ 
    & vbNewLine & vbNewLine & "__________" & vbNewLine & vbNewLine & " I will try and let you know what happened ASAP.", , "I've gone Wonky." 
GoTo 100 

102 
    MsgBox "This Macro can only run on a formatted Deduction Report or an FBL5N." _ 
     & vbNewLine & vbNewLine & "If you are using either one, please exactly name the tabs 'Line Item Detail' for a Dedution Report or 'FBL5N' for an FBL5N" _ 
      , vbOKOnly, "Line Item Detail or FBL5N Missing" 
GoTo 100 

End Sub 

(가 더 sence을하지 않습니다 어디 몇 가지 코드가 주석 참고) 이러한 오류를 수정하기 위해 리팩토링 코드입니다