CODEWITHSUNDEEP
vbaexcel
user3623366
user3623366

Reputation: 5

VBA copy rows that meet criteria to another sheet pasting only values

I would like to modify this macro to paste the copied rows with their original formatting and only their values as the rows being copied have formulas in them. I tried placing PasteSpecial xlPasteValues after Rows(j+6) but that did not do the trick. 

    Sub customcopy()
    Dim strsearch As String, lastline As Integer, tocopy As Integer

    strsearch = CStr(InputBox("enter the string to search for"))
    lastline = Range("A65536").End(xlUp).Row
    j = 1

    For i = 1 To lastline
       For Each c In Range("C" & i & ":Z" & i)
          If InStr(c.Text, strsearch) Then
               tocopy = 1
           End If
        Next c
        If tocopy = 1 Then
             Rows(i).Copy Destination:=Sheets("Sheet2").Rows(j + 6)
             j = j + 1
        End If
    tocopy = 0
    Next i

    End Sub

Upvotes: 0

Views: 2541

Answers (3)

Dan Wagner
Dan Wagner

Reputation: 2713

I'm sure there are certainly better ways to keep the formatting AND drop in only the values, but one quick solution might be to first paste everything (that way you've got the formatting), THEN paste just the values:

Rows(i).Copy Destination:=Sheets("Sheet2").Rows(j + 6)
Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteValues

Upvotes: 0

Gary's Student
Gary's Student

Reputation: 96753

Try:

Sub customcopy()
    Dim strsearch As String, lastline As Long, tocopy As Long
    strsearch = CStr(InputBox("enter the string to search for"))
    lastline = Range("A65536").End(xlUp).Row
    j = 1
    For i = 1 To lastline
       For Each c In Range("C" & i & ":Z" & i)
          If InStr(c.Text, strsearch) Then
               tocopy = 1
           End If
        Next c
        If tocopy = 1 Then
             Rows(i).Copy
             Sheets("Sheet2").Rows(j + 6).PasteSpecial (xlValues)
             Sheets("Sheet2").Rows(j + 6).PasteSpecial (xlFormats)
             j = j + 1
        End If
        tocopy = 0
    Next i
End Sub

Upvotes: 0

Prabhat Srivastava
Prabhat Srivastava

Reputation: 197

Try this 

Sub customcopy()
Dim strsearch As String, lastline As Integer, tocopy As Integer

strsearch = CStr(InputBox("enter the string to search for"))
lastline = Range("A65536").End(xlUp).Row
j = 1

For i = 1 To lastline
   For Each c In Range("a" & i & ":a" & i)
      If InStr(c.Text, strsearch) Then
           tocopy = 1

       End If
    Next c
    If tocopy = 1 Then
         Rows(i).Copy
         Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteValues
         Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteFormats

         j = j + 1
    End If
tocopy = 0
Next i

End Sub

Upvotes: 0

Related Questions