简体   繁体   中英

Copy value not formula excel vba

i have a piece of code that copies a row from one excel to another. The problem is that columns E to G an N to O have a reference to another excel and when it copies it copies the formula not the cell value resulting in repeating the formula to the target column in descending order. I have tried with hide/ unhide but it doesn't do much difference. The target column D it will result in D1= 1.xslm/sheet1/formula(n1) ; D2= 2.xslm/sheet1/formula(n2) ... - that are the reference from the source sheet column D. In the source the values are ok, in the target the formula is just wrong and it shouldn't have n1, n2 ... . If the source row is 122 in target it should be D1= 1.xslm/sheet1/formula(n122) , D2= 2.xslm/sheet1/formula(n122)

Sub copy1()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Sour As String
    Dim Tar As String
    Dim path As String
    Dim AutoSR As Workbook
    Dim asrSheet As Worksheet
    Set AutoSR = ActiveWorkbook
    Set Target = AutoSR.ActiveSheet

    path = "c:\first.xlsm"
    Tar = "Sheet1"
    Set Source = Workbooks.Open(path).Sheets(Tar)
    Source.Unprotect Password:="XXX"
    Application.DisplayAlerts = False
    Columns("E:G").EntireColumn.Hidden = False
    Columns("N:O").EntireColumn.Hidden = False
    Source.Range("N:O").EntireColumn.Hidden = True
    For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)
        If c = lNum Then
           Source.Rows(c.Row).Copy Target.Rows(1)
        End If
    Next c
    Source.Range("E:G").EntireColumn.Hidden = True
    Source.Range("N:O").EntireColumn.Hidden = True
    Source.Protect Password:="XXX"
    Source.Activate
    ActiveWorkbook.Close SaveChanges:=True
    Set Source = Nothing

End Sub

Replace:

Source.Rows(c.Row).Copy Target.Rows(1)

By:

Source.Rows(c.Row).Copy 
Target.Rows(1).PasteSpecial xlPasteValues

This will paste the values and not the formulas

EDIT This answer is a quick and dirty fix! Check out the answer form Jeeped for a more extensive improvement of OP's code.

To start off, have a look at this line.

For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)

The Cells.SpecialCells(... does not explicitly refer to the Source worksheet. It is implicitly referring to the ActiveSheet property . By coincidence, this also happens to be the Source worksheet since opening that workbook made it the ActiveSheet. However, this should not be relied upon. Better to explicitly define all Range.Parent worksheet properties.

For Each c In Source.Range("a1:a" & SOURCE.Cells.SpecialCells(xlCellTypeLastCell).Row)

As far as copying values only, you could use a Range.PasteSpecial method with a xlPasteType of xlPasteValues. However, direct value transfer is a more efficient method of transferring values and it does not involve the clipboard or .CutCopyMode .

Replace all of this,

For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    If c = lNum Then
       Source.Rows(c.Row).Copy Target.Rows(1)
    End If
Next c

... with this,

Dim rw as Variant
With Source
    rw = Application.Match(lNum, .Columns(1), 0)
    If Not IsError(rw) Then
        With .Range(.Cells(rw, "A"), .Cells(rw, .Columns.Count).End(xlToLeft))
            Target.Cells(1, 1).Resize(.Rows.Count, .Columns.Count) = .Value
        End With
    End If
End With

That takes everything from column A to the last populated cell on the matching row the Source worksheet and transfers the values to the Target worksheet radiating out from column A1.

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