CODEWITHSUNDEEP
excelvba
headband07
headband07

Reputation: 1

Paste Rows as values if a cell meets criteron

I need to copy specific rows from one sheet to another sheet in my workbook if the value in one of the cells matches a certain criterion I'm looking for but I only want to paste as values since the sheet I'm copying from has formulas. I'm able to get part of what I want but can't paste as values

I'm very new to VBA so I'm having trouble.

I was able to create the below code by looking at examples online which does copy and paste what correctly but it doesn't paste as just values. I tried using PasteSpecial xlPasteValues but the following error: PasteSpecial method of Worksheet class failed".

From looking at other posts I gather that the issue is that I'm an entire sheet as the input rather a defined range. I'm just not sure how to update my code to still check the cell value but have a range. Again, I'm very new to VBA so my apologies if there is a common or simple solution that I missed.

Thank you in advance!

Sub CopyRows()

    Sheets("Rise Format").Select
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
        ThisValue = Cells(x, 1).Value
        If ThisValue = "1" Then
            Cells(x, 1).Resize(1, 27).Copy
            Sheets("Rise Format Export").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Rise Format").Select
        End If
    Next x
    Sheets("Tracker").Select
End Sub

Upvotes: 0

Views: 42

Answers (1)

Notus_Panda
Notus_Panda

Reputation: 2810

If you don't want to use AutoFilter and copy/pastespecial the visible rows, you can use an array to give the values you need to your other sheet without using the clipboard.

Sub betterCopy()
    Dim wsS As Worksheet, wsD As Worksheet
    Dim rngS As Range
    Dim rCount As Long, lRowS As Long, lRowD As Long
    Const cCount As Long = 27
    Dim srValue As String
    
    Set wsS = ActiveWorkbook.Sheets("Rise Format") 'setting your worksheets
    Set wsD = ActiveWorkbook.Sheets("Rise Format Export")
    lRowS = wsS.Range("A" & Rows.Count).End(xlUp).Row 'lRows of source
    lRowD = wsD.Range("A" & Rows.Count).End(xlUp).Row 'and of destination sheet
    Set rngS = wsS.Range("A1:A" & lRowS) 'search range
    rCount = 0
    Dim srData(): srData = rngS.Value 'placing the values in an array
    Dim dData(): ReDim dData(1 To cCount, 1 To lRowS)
    Dim i As Long, j As Long, srCounter As Long: srCounter = 1
    'to Redim Preserve later we need to "think transposed" since you can
    'only Redim Preserve the last dimension (we want to shorten the rows to what
    'we actually need, not the entire lRowS
    For i = 1 To lRowS 'per row checking if it has a 1 in the A-column
        If srData(i, 1) = "1" Then
            rCount = rCount + 1 'amount of rows added in the destination array dData
            For j = 1 To cCount
                dData(j, rCount) = wsS.Cells(i, j).Value 'filling dData
            Next j
        End If
    Next i
    ReDim Preserve dData(1 To cCount, 1 To rCount) 'keeping only the used rows
    If lRowD <> 1 Then lRowD = lRowD + 1
    wsD.Range("A" & lRowD).Resize(rCount, cCount).Value = Application.Transpose(dData)
    'Transpose needed after we succesfully used Redim Preserve
    'the range gets the entire dData at once
End Sub

This doesn't use Select either, which @Kairu commented, is unnecessary in most cases.

If you do use AutoFilter, don't forget to use .PasteSpecial Paste:=xlPasteValues but since this does use the clipboard, be aware that it might take longer with bigger data sets.

Upvotes: 0

Related Questions