VBA Excel将两个工作表的dynamic范围合并为一个1004粘贴错误

我试图将来自两个不同电子表格的数据合并成一个成为数据透视表的数据源。 两张纸都有不同的布局，所以我在第一张纸上循环查找列，复制下面的数据范围，然后粘贴到wDATA表中。 然后转到下一页，find相同的标题，然后粘贴到第一个块的下面。 我得到我最喜欢的错误，1004。我已经尝试了不同的礼仪和方法，但它不会粘贴，所以这是我开始。 链接是具有较大位和数据的文件。 我保证它干净。 任何帮助？

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. 不是所有的variables都被定义或设置
4. 从FBL5N复制时，您的索引编入wData FBL5N覆盖标题
5. 从“ Line Item Detail复制时，您将数据编入wData似乎是错误的（重写第一个数据集

这里是你的代码重构，以纠正这些错误（注意一些代码被注释掉在哪里没有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