Есть ряд проблем с этим кодом
- Вы не квалифицируете все свои ссылки на
Range и Cells. В результате получается ссылка на активный лист, а не всегда то, что вы хотите.
- Вы копируете формулы из исходных таблиц, что приводит к некорректным вычислениям. вероятно, хотите скопировать значения вместо
- Не все ваши переменные определены или установлены
- Ваш индекс в
wData при копировании из FBL5N перезаписывает заголовки
- Ваш индекс в
wData при копировании из Line Item Detail кажется неправильным (игнорирует первый набор данных
Вот ваш код, реорганизованный для исправления этих ошибок (обратите внимание, что некоторый код закомментирован там, где он не имеет смысла)
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