VBA Excel 2つのシートのダイナミックレンジを1つの1004のペーストエラーにマージする

2つの異なるスプレッドシートのデータを、ピボットテーブルのデータソースとなるものにマージしようとしています。両方のシートはレイアウトが異なるので、最初のシートをループしてその列を見つけ出し、その下のデータ範囲をコピーしてからwDATAシートに貼り付けます。次に、次のシートに移動し、同じヘッダーを見つけて、最初のブロックの下に貼り付けます。私はお気に入りのエラー、1004を取得しています。私はさまざまな方法や手法を試しましたが、貼り付けられないので、ここから始めました。 Linkは、より大きなビットとデータを持つファイルです。私はその清潔を約束します。どんな助け？VBA Excel 2つのシートのダイナミックレンジを1つの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

出典

2012-01-07 Bippy

問題のコード行である：

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

あなたはCellsオブジェクトRangeオブジェクトを修飾しますが、いませんでした。資格なしでは、ActiveSheetが想定されます。代わりにこれを試してみてください：

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

出典

2012-01-07 23:24:04

OOoooo、私はこれがより好きです。 Activesheetプロパティを使うことができたので、私は質問を殺すために戻ってきました。しかし、これははるかに良いです。 – Bippy

ザ・あなたはRange年代とCellsへのすべての参照を修飾されていないこのコード

で多くの問題です。この結果、アクティブなシートを参照することになります。
ソースシートから数式をコピーしているため、計算が正しく行われません。 Line Item Detailからコピーする（overrights最初のデータは
ないすべての変数が定義されているかFBL5NからコピーするwDataにヘッダ
あなたのインデックスを上書きするとき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

出典

2012-01-08 00:01:14

誰かが自分のコードを編集してくれたことは初めてであり、私が読んでいたことの多くは今では意味をなさないものです。ありがとう、これは本当にクールです。 – Bippy

@Bippy - あなたはいつも受け入れられた答えを変更することができます... –

私のコードを編集することで誰かが私を助けてくれました。ありがとう、これは本当にクールです。

ありがとうございます。元のコードにはもっと間違いがあります。しかし、あなたが私に示したことは、それをよりきれいにし、実行可能にするのに役立ちます。 – Bippy

VBA Excel 2つのシートのダイナミックレンジを1つの1004のペーストエラーにマージする

答えて

関連する問題