Excel VBA Αντιγραφή Επικόλληση τιμών μόνο ( xlPasteValues )

Προσπαθώ να αντιγράψω ολόκληρη τη στήλη του φύλλου Α στο φύλλο Β. Η στήλη του φύλλου Α έχει τιμές που σχηματίζονται με τύπους. Αντιγράφω τις τιμές της στήλης SheetA μόνο χρησιμοποιώντας xlPasteValues. Αλλά δεν επικολλάω τις τιμές σε ένα άλλο φύλλοB. Η στήλη στο φύλλοB είναι κενή. Ο κώδικάς μου VBA

    Public Sub CopyrangeA()

    Dim firstrowDB As Long, lastrow As Long
    Dim arr1, arr2, i As Integer

    firstrowDB = 1
    arr1 = Array("BJ", "BK")
    arr2 = Array("A", "B")

         For i = LBound(arr1) To UBound(arr1)
        With Sheets("SheetA")
           lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
           .Range(.Cells(1, arr1(i)), .Cells(lastrow, arr1(i))).Copy
           Sheets("SheetB").Range(arr2(i) & firstrowDB).PasteSpecial xlPasteValues
        End With
    Next
    Application.CutCopyMode = False

End Sub
Λύση

Αν θέλετε απλώς να αντιγράψετε ολόκληρη τη στήλη, μπορείτε να απλοποιήσετε πολύ τον κώδικα κάνοντας κάτι τέτοιο:

Sub CopyCol()

    Sheets("Sheet1").Columns(1).Copy

    Sheets("Sheet2").Columns(2).PasteSpecial xlPasteValues

End Sub

Ή

Sub CopyCol()

    Sheets("Sheet1").Columns("A").Copy

    Sheets("Sheet2").Columns("B").PasteSpecial xlPasteValues

End Sub

Ή αν θέλετε να διατηρήσετε το βρόχο

Public Sub CopyrangeA()

    Dim firstrowDB As Long, lastrow As Long
    Dim arr1, arr2, i As Integer

    firstrowDB = 1
    arr1 = Array("BJ", "BK")
    arr2 = Array("A", "B")

    For i = LBound(arr1) To UBound(arr1)

        Sheets("Sheet1").Columns(arr1(i)).Copy

        Sheets("Sheet2").Columns(arr2(i)).PasteSpecial xlPasteValues

    Next
    Application.CutCopyMode = False

End Sub
Σχόλια (1)

Θα ήθελα να πάω χωρίς αντιγραφή/επικόλληση

      Sheets("SheetB").Range(arr2(i) & firstrowDB).Resize(lastrow, 1).Value = .Range(.Cells(1, arr1(i)), .Cells(lastrow, arr1(i))).Value
Σχόλια (0)

Προσωπικά, θα το συντόμευα κι εγώ λίγο, αν το μόνο που χρειάζεστε είναι οι στήλες:

For i = LBound(arr1) To UBound(arr1)
    Sheets("SheetA").Columns(arr1(i)).Copy
    Sheets("SheetB").Columns(arr2(i)).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next

καθώς από αυτό το απόσπασμα κώδικα, δεν υπάρχει ιδιαίτερο νόημα στα lastrow ή firstrowDB

Σχόλια (0)