CODEWITHSUNDEEP
excelvbapaste
gluc7
gluc7

Reputation: 585

VBA- Copy and pasting row on another sheet as a value

I am moving rows from one sheet to another based on a criteria in a cell value. If the cell value is met, it moves to another sheet. However when it moves, I need it to move as values. One of my cells has a formula in it and I just want the value of that cell in the new sheet. Below is part of my code where it moves the row. My question is where do I add in the PasteSpecial or the equivalent code to move it as values? Thanks!

    For Each xCell In xRg
    If CStr(xCell.Value) = "Pipeline" Then
        xCell.EntireRow.Copy Destination:=Worksheets("Pipeline2").Range("A" & B + 1)
        xCell.EntireRow.Delete
        B = B + 1

Upvotes: 0

Views: 2473

Answers (4)

user7351900
user7351900

Reputation:

Something like this should do it for you.

Sub copy_paste() 
    Dim i As Integer 

    i = 2 

    Sheets("Sheet1").Select 
    Range("E2").Select 

    Do While ActiveCell <> "" 
        If Range("E" & ActiveCell.Row) <> "" And Range("F" & ActiveCell.Row) <> "" Then 
            Range("E" & ActiveCell.Row).Copy Sheets(Sheet3).Range("B" & i) 
            Range("F" & ActiveCell.Row).Copy Sheets(Sheet3).Range("E" & i) 
            Range("A" & ActiveCell.Row).Copy Sheets(Sheet3).Range("F" & i) 
            Range("H" & ActiveCell.Row).Copy Sheets(Sheet3).Range("G" & i) 
            Range("I" & ActiveCell.Row).Copy Sheets(Sheet3).Range("H" & i) 
            Range("K" & ActiveCell.Row).Copy Sheets(Sheet3).Range("I" & i) 
            i = i + 1 
        End If 
        ActiveCell.Offset(1, 0).Select 
    Loop 

End Sub

Upvotes: 0

BruceWayne
BruceWayne

Reputation: 23285

If you just want the values, you can just set the ranges equal to eachother.

For Each xCell In xRg
    If CStr(xCell.Value) = "Pipeline" Then
        Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.Value = xCell.EntireRow.Value

        xCell.EntireRow.Delete
        B = B + 1

Edit: To keep formatting also,

For Each xCell In xRg
    If CStr(xCell.Value) = "Pipeline" Then
        Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.Value = xCell.EntireRow.Value
        xCell.EntireRow.Copy
        Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        xCell.EntireRow.Delete
        B = B + 1

Upvotes: 1

user3598756
user3598756

Reputation: 29421

building on "Batman" solution, you could limit the actually copied range values to the minimum required (i.e. from column 1 to last not empty cell in that row): 

For Each xCell In xRg
    If CStr(xCell.Value) = "Pipeline" Then
        With xCell.Parent
            With .Range(.Cells(xCell.row, 1), .Cells(xCell.row, .Columns.count).End(xlToLeft))
               Worksheets("Pipeline2").Range("A" & B + 1).Resize(.Columns.count).Value = .Value
            End With
        End With
        xCell.EntireRow.Delete
        B = B + 1

Upvotes: 0

Jeremy
Jeremy

Reputation: 1337

I don't believe you can (which is weird) but you'll have to declare the original worksheet, then copy, then pastespecial, then go back.. something like this:

'......
Set ws1 = Activeworksheet
  For Each xCell In xRg
    If CStr(xCell.Value) = "Pipeline" Then
        xCell.EntireRow.Copy Destination:=Sheets("Pipeline2").Range("A" & B + 1)
        Sheets("Pipeline2").Activate
        Sheets("Pipeline2").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ws1.astivate
        xCell.EntireRow.Delete
        B = B + 1

Upvotes: 0

Related Questions