简体   繁体   中英

VBA : Copying the specific columns from one sheet to another sheet

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM