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

person Bippy    schedule 07.01.2012    source източник


Отговори (2)


Проблемът е в този ред код:

wDATA.Range(Cells(1, 1), Cells(lEndRowA + lEndRowB, 1))

Вие сте квалифицирали обекта Range, но не и обектите Cells. Без квалификация се приема ActiveSheet. Опитайте това вместо това:

wDATA.Range(wDATA.Cells(1, 1), wDATA.Cells(lEndRowA + lEndRowB, 1))
person Rachel Hettinger    schedule 07.01.2012
comment
ООоооо, това ми харесва повече. Върнах се, за да убия въпроса, защото разбрах, че мога да използвам свойството Activesheet. Но това е много по-хубаво. - person Bippy; 08.01.2012

Има редица проблеми с този код

  1. Вие не квалифицирате всичките си препратки към Range и Cells. Това води до препратка към активния лист, не винаги това, което искате.
  2. Вие копирате формули от изходните листове, което води до неправилни изчисления. вероятно вместо това искате да копирате стойности
  3. Не всички ваши променливи са дефинирани или зададени
  4. Вашето индексиране в wData при копиране от FBL5N презаписва заглавките
  5. Вашето индексиране в 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
person chris neilsen    schedule 08.01.2012
comment
Това е първият път, когато някой ми помага, като редактира кода ми и много неща, които прочетох, имат смисъл сега. Благодаря, това е наистина страхотно. - person Bippy; 08.01.2012
comment
Това е първият път, когато някой ми помага, като редактира кода ми и много неща, които прочетох, имат смисъл сега. Благодаря, това е наистина страхотно. ‹br/›‹br/›О, да, сър, има още много грешки в оригиналния код. Но това, което ми показа, ще го направи по-чист и работещ. - person Bippy; 08.01.2012
comment
Уау, мозъкът ми може да работи, вече не мога да натискам правилно клавишите. Препълването на стека трябва да има повече от един приет отговор. Какво е това? Борба за лодки? - person Bippy; 08.01.2012