So, after roughly 3 hours or more of searching google and for an answer, I can't seem to find an answer that fits my specific case. I've been grappling with a macro, and finally have it mostly working BUT getting it to copy/paste to a new sheet is vexing me to no ends. Here's the copy/paste lines (also the prior copy/paste that I tried to make work before I gave up on it) :
Sub Filtration()
Application.Goto Sheet1.Range("R1")
Application.ScreenUpdating = False
Dim writeRow As Integer
Dim percentage As Double
'to create skip conditions for row 1 & 2
counter = 1
For Each Cell In Sheets(1).Range("R:R")
'second part of skip condition
If counter > 2 Then
'creates condition to ignore blank cells or cells with a zero or negative number
If Cell.Value = "" Or Cell.Value <= 0 Then
Else
'creates a way to ignore offset cells if =< 0 (might need to add in for blank too)
If Cell.Offset(, -2).Value <= 0 Then
percentage = 0
Else
percentage = Cell.Value / Cell.Offset(, -2).Value
End If
'divide the current cell's value by the the cell one column over's value and compare
If percentage > 0.02 Then
Set Mastersheet = Worksheets("Sheet1") ' Copy From this sheet
Set Pastesheet = Worksheets("Sheet2") ' to this sheet
Cell.EntireRow.Copy ' copy the row from column O that meets that requirements (above, 1 and also win in Q)
'Pastesheet.Cells(lastRow + 1, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Dim LastRow As Long
With Pastesheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' get last row in column "A
.Cells(LastRow + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats
End With
End If
End If
End If
'final part of skip condition to ignore the two headers - has to be here to work, before next but after the last End IF
counter = counter + 1
Next
Application.ScreenUpdating = True
End Sub
The commented copy/paste just errors out on me on the writeRow part and couldn't figure out why, and searching turned up no reasons either. The second half works but just overwrites the same row over and over, and all the answers and examples I found out there claim it should work, so I'm at a loss. Does anyone have any ideas?
I guess you are after something like the code below (this section of code takes care only for the Paste section):
Dim LastRow As Long
Dim LastCell As Range
With Pastesheet
' safer way to get the last row
Set LastCell = .Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, _
searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False)
If Not LastCell Is Nothing Then
LastRow = LastCell.Row
End If
.Cells(LastRow + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats
End With
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments