Excel VBA 동일한 행을 덮어 쓰는 복사/붙여 넣기

Question

Google 검색에서 약 3 시간 이상 경과 한 후 특정 사례에 맞는 대답을 찾지 못하는 것 같습니다. 나는 매크로로 씨름하고 있었고 마침내 대부분 작동했지만 새 시트에 복사/붙여 넣기를하는 것은 끝까지 나를 괴롭 히고있다. writeRow 부분 나오지 않았어 날에

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