VBA Excel Слияние динамических диапазонов от двух листов до одной, 1004 пасты

Я пытаюсь объединить данные из двух разных листов распространения в один, который становится источником данных для пары сводных таблиц. Оба листа имеют разные макеты, поэтому я просматриваю первый лист, чтобы найти столбец, скопируйте диапазон данных под ним, а затем вставьте его в лист 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)) 

Есть ряд проблем с этим кодом

  1. Вы не квалифицируете все свои ссылки на Range и Cells . Это приводит к ссылке на активный лист, а не всегда на то, что вы хотите.
  2. Вы копируете формулы из ваших исходных текстов, что приводит к неправильным вычислениям. возможно, вместо этого нужно скопировать значения
  3. Не все ваши переменные определены или заданы
  4. Ваша индексация в wData при копировании из FBL5N перезаписывает заголовки
  5. Ваша индексация в wData при копировании из 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 того, как 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 
  • не может объединить ячейки в рабочем листе VBA 2007 notactive
  • Powershell превосходит ячейки слияния, когда ячейка может меняться
  • Объединение групп ячеек относительно столбца A
  • Более детальное решение о том, как объединить ячейки между двумя значениями во втором столбце
  • Объединить файлы csv, чтобы преуспеть в Python
  • Как диапазон слияния / смешивания ячейки в качестве параметра формулы
  • Автоматическая группировка / слияние в Excel
  • Убедитесь, что объединенные ячейки пусты
  • Слияние и форматирование Excel
  • форматирование ячеек в excel с использованием python
  • Объединить строки и значения сумм в листе
  • Давайте будем гением компьютера.