VBA:将特定列从一个工作表复制到另一个工作表

时间:2017-07-11 10:34:49

标签: excel vba excel-vba

您好我正在尝试将特定列从一个工作表复制到另一个工作表但下面的代码运行时错误1004' .Range(MyCopyRange).Copy此代码上的对象定义或应用程序定义错误。任何人都可以帮助它会感激。

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

1 个答案:

答案 0 :(得分: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