VBA: Kopieren der spezifischen Spalten von einem Blatt zu einem anderen Blatt

Question

Hallo, ich versuche, die spezifischen Spalten von einem Blatt in ein anderes Blatt zu kopieren, aber der unten Code Laufzeitfehler 1004 'Objekt definiert oder Anwendung definiert Fehler auf .Range(MyCopyRange).Copy dieser Code . Jeder kann helfen es würde sich freuen.

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

Ihr Code brauchte nur eine Schleife, um Array-Elemente herauszuziehen.

Bitte versuchen Sie den folgenden 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