VBA：将特定的列从一张纸复制到另一张纸

Question

Hi i am trying to copy the specific columns from one sheet to another sheet but the below code getting run time error 1004' object defined or application defined error on .Range(MyCopyRange).Copy this code. anybody can assist it would appreciate.

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

Answer 1

Your code just needed a loop to pull out array elements.

Please try the below code.

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