您好我正在尝试将特定列从一个工作表复制到另一个工作表但下面的代码运行时错误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
答案 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