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. Не все ваши переменные определены или установлены
4. Вашего индексирования в wData при копировании из FBL5N перезаписывает заголовки
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