Reputation: 23
How do I copy a formula result?
I select which rows to keep in the worksheet "UI", by marking the rows with the value 1 in column B.
I assigned the following macro to a command button, which copies the selected rows to the worksheet "Output":
Private Sub CommandButton1_Click()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("UI")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Output")
For i = 2 To ws1.Range("B999").End(xlUp).Row
If ws1.Cells(i, 2) = "1" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
Next i
End Sub
As the values in the rows are the results of formulas, the results pasted in "Output" come back as invalid cell references.
Is there a way of copy-pasting as text?
Upvotes: 2
Views: 229
Reputation: 61
You should use "xlPasteValues" property to avoid invalid cell references when values in the rows are the results of formulas. You can try to modify your code as follows:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = Sheets("UI")
Dim ws2 As Worksheet: Set ws2 = Sheets("Output")
For i = 2 To ws1.Range("B999").End(xlUp).Row
If ws1.Cells(i, 2) = "1" Then
ws1.Rows(i).Copy
ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next i
End Sub
Upvotes: 1
Reputation: 55038
The Code
Option Explicit
Private Sub CommandButton1_Click()
' Source
Const sName As String = "UI"
Const sFirstRow As Long = 2
Const Criteria As String = "1" ' 'Const Criteria as long = 1'?
' Destination
Const dName As String = "Output"
Const dCell As String = "A2"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Define Source Range (assuming 'UsedRange' starts in cell 'A1').
Dim rg As Range: Set rg = wb.Worksheets(sName).UsedRange
' Write values from Source Range to Data Array.
Dim Data As Variant: Data = rg.Value ' assuming 'rg' has at least two cells
Dim cCount As Long: cCount = UBound(Data, 2)
' Declare additional variables.
Dim cValue As Variant
Dim i As Long, j As Long, k As Long
' Loop and write matching values to the beginning of Data Array.
For i = sFirstRow To UBound(Data, 1)
cValue = Data(i, 2)
If Not IsError(cValue) Then
If cValue = Criteria Then
k = k + 1
For j = 1 To cCount
Data(k, j) = Data(i, j)
Next j
End If
End If
Next i
' Write matching values from Data Array to Destination Range.
If k > 0 Then
With wb.Worksheets(dName).Range(dCell)
.Resize(.Worksheet.Rows.Count - .Row + 1, _
.Worksheet.Columns.Count - .Column + 1).ClearContents
.Resize(k, cCount).Value = Data
End With
MsgBox "Data transferred.", vbInformation, "Success"
Else
MsgBox "No matches found.", vbExclamation, "Fail?"
End If
End Sub
Upvotes: 1