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)) 

你合格Range对象，但不是Cells对象。没有资格，假设ActiveSheet。试试这个：

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

Answer 2

的许多问题与此代码

1. 你没有资格来Range的和Cells所有引用。这会导致引用活动工作表，而不总是您想要的。
2. 您正在复制源表单中的公式，这会导致计算错误。可能想复制值而不是
3. 并非所有的变量定义或FBL5N复制时设置
4. 你索引到wData覆盖头
5. 你的索引为wData从Line Item Detail复印时，似乎是错误的（overrights第一数据集

这里是你的代码重构，以纠正这些错误（注意一些代码被注释掉，它是没有SENCE）

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