2017-07-11 10 views
0

こんにちは、特定の列を別のシートにコピーしようとしましたが、実行時エラー1004 'オブジェクトが定義されている以下のコードまたはアプリケーション定義エラー.Range(MyCopyRange).Copy 。誰でもそれが感謝するのを助けることができます。VBA:あるシートから別のシートに特定の列をコピーする

Sub CopyingColms() 
Dim LR As Long, MyCopyRange As Variant, MyPasteRange As Variant, X As Long 
ThisWorkbook.Activate 
With Sheets("Sheet3") 
    LR = .Range("B" & .Rows.Count).End(xlUp).Row 
    MyCopyRange = Array("C2:C" & LR, "E2:E" & LR, "B2:B" & LR, "F2:F" & LR, "G2:G" & LR, "H2:H" & LR, "I2:I" & LR, "K2:K" & LR, "J2:J" & LR, "L2:L" & LR, "M2:M" & LR, "N:2:N" & LR, "AE2:AE" & LR, "Z2:Z" & LR, "D2:D" & LR, "AG2:AG" & LR, "AF2:AF" & LR) 'Put ranges in an array 
    MyPasteRange = Array("A2", "B2", "C2", "D2", "E2", "F2", "G2", "H2", "I2", "J2", "K2", "L2", "M2", "N2", "O2", "P2", "Q2") 

    If LR > 1 Then 
     For X = LBound(MyCopyRange) To UBound(MyCopyRange) 'Loop the array copying and pasting based on element in the array 
      .Range(MyCopyRange).Copy 
      Sheets("Sheet1").Range(MyPasteRange).PasteSpecial xlPasteValues 
     Next 
    Else 
     Range("A2") = "No Data Found for this month" 
    End If 

End With 

End Sub 

答えて

0

あなたのコードでは、配列要素を引き出すためのループが必要でした。

次のコードを試してください。

Sub CopyingColms() 
Dim LR As Long, X As Long 
ThisWorkbook.Activate 
With Sheets("Sheet3") 
    LR = .Range("B" & .Rows.Count).End(xlUp).Row 
    MyCopyRange = Array("C2:C" & LR, "E2:E" & LR, "B2:B" & LR, "F2:F" & LR, "G2:G" & LR, "H2:H" & LR, "I2:I" & LR, "K2:K" & LR, "J2:J" & LR, "L2:L" & LR, "M2:M" & LR, "N:2:N" & LR, "AE2:AE" & LR, "Z2:Z" & LR, "D2:D" & LR, "AG2:AG" & LR, "AF2:AF" & LR) 'Put ranges in an array 
    MyPasteRange = Array("A2", "B2", "C2", "D2", "E2", "F2", "G2", "H2", "I2", "J2", "K2", "L2", "M2", "N2", "O2", "P2", "Q2") 

    If LR > 1 Then 
    j = 1 'added 
     For X = LBound(MyCopyRange) To UBound(MyCopyRange) 'Loop the array copying and pasting based on element in the array 
     .Range(MyCopyRange(j)).COPY 
      Sheets("Sheet1").Range(MyPasteRange(j)).PasteSpecial xlPasteValues 
      j = j + 1 'added 
     Next 
    Else 
     Range("A2") = "No Data Found for this month" 
    End If 

End With 

End Sub 
関連する問題