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. 从FBL5N 复制时，您对wData 的索引会覆盖标题
5. 从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