Excel VBA Само копиране на стойности за поставяне( xlPasteValues )

Опитвам се да копирам цяла колона в лист А в лист Б.В колоната на лист А има стойности, формирани с формули. Копирам стойностите на колоната в лист А само с помощта на 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
sam
Редактиран въпрос Направете май 2014 в 3:50
Програмиране
vba excel copy-paste excel-vba
Направете май 2014 в 3:41
11 изгледи
Решение

Ако искате просто да копирате цялата колона, можете да опростите кода много, като направите нещо подобно:

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)

Бих минал без copy/paste

      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)