Excel VBA同じ行を上書きコピー/貼り付け

Question

Googleを検索して約3時間以上経過した後、特定のケースに合った答えが見つからないようです。私はマクロに取り組んできましたが、最終的にはほとんど動作しましたが、新しいシートにコピー/ペーストすることは、私には無駄です。 writeRow部分とcouldnに私に

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 

コメントのコピー/ペーストだけでエラーが出て：ここでは（私はそれをあきらめた前に、私は仕事を作ってみましたまた、先行コピー/貼り付け）コピー/ペーストラインです理由を見つけ出すことができず、検索しても何の理由もありませんでした。後半は動作しますが、同じ行を何度も上書きするだけです。私がそこで見つけたすべての回答と例がうまくいくと主張しているので、私は迷っています。誰にもアイデアはありますか？

Answer 1

私は（コードのこのセクションは唯一貼り付けセクションのための世話をする）あなたは以下のコードのようなものの後にあると思います：

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