我正试图将来自两个不同电子表格的数据合并到一个电子表格中,该表格将成为几个数据透视表的数据源。两张工作表都有不同的布局,所以我循环浏览第一张工作表以找到列,复制它下面的数据范围,然后粘贴到wDATA工作表中。然后转到下一页,找到相同的标题,然后粘贴在第一个块下面。我得到了我最喜欢的错误,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
问题出在这行代码上:
wDATA.Range(Cells(1, 1), Cells(lEndRowA + lEndRowB, 1))
您已经限定了Range
对象,但没有限定Cells
对象。在没有限定的情况下,假定为ActiveSheet
。试试这个:
wDATA.Range(wDATA.Cells(1, 1), wDATA.Cells(lEndRowA + lEndRowB, 1))
此代码存在许多问题
- 您没有对
Range
和Cells
的所有引用进行限定。这会导致对活动工作表的引用,而不总是您想要的 - 您正在从源工作表中复制公式,这会导致计算不正确。可能要复制值
- 并非所有变量都已定义或设置
- 从
FBL5N
复制时对wData
的索引会覆盖标头 - 当从
Line Item Detail
复制时,您对wData
的索引似乎是错误的(覆盖了第一个数据集
以下是为了纠正这些错误而重构的代码(请注意,有些代码在没有意义的地方被注释掉了)
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