Suchen Sie Zellenwert größer als Null und kopieren Sie in ein anderes Arbeitsblatt

Question

Ich möchte überprüfen, ob der Zellenwert B größer als Null ist, wenn ja, möchte ich die ganze Zeile in ein anderes Arbeitsblatt kopieren. Mein Code ist unten angegeben, es funktioniert, aber ich möchte es verbessern, weil ich mit A65000 hart-Code. Bitte geben Sie an, wie Sie die Zelle B bis zum letzten Fülldatum überprüfen können.

Sub Search_Number() 
    'copy row if cell greater than zero 
    Dim i As Range 

    Sheets("HVM").Select 

    For Each i In Range("I:I") 
     If i.Value > 0 Then 
      i.Select 
      ActiveCell.Rows("1:1").EntireRow.Select 
      Selection.Copy 
      Sheets("Blocked").Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial 

     End If 
    Next i 
End Sub 

Answer 1

Dieser Code überprüft, ob der Wert in der Spalte b größer als 0 ist und auf sheet1 kopiert die gesamte Reihe eines auf die erste leere Zeile in der Spalte Tabelle2. In diesem Code wird davon ausgegangen, dass Sie keine Kopfzeilen haben und die Daten in Zeile 1 beginnen und die gesamte Zeile in ein anderes Blatt eingefügt werden soll, das in Zeile 1 beginnt. Dieser Code funktioniert schließlich nur, wenn Blatt1 die Quelle zum Kopieren ist und Blatt 2 das leeres Blatt zu kopieren.

Dim rng As Range 
Dim cell As Range 
Dim lr As Long 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 

Set ws1 = Sheet1 
Set ws2 = Sheet2 

lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row 
Set rng = ws1.Range("b1:b" & lr) 

For Each cell In rng 
    If cell.Value > 0 Then 
    cell.EntireRow.Copy 
    ws2.Select 
    If ws2.Range("A1").Value = "" Then 
     ws2.Range("a1").PasteSpecial xlPasteValues 
    Else 
     Cells((Cells(Rows.Count, "a").End(xlUp).Row) + 1, "a").PasteSpecial xlPasteValues 
    End If 
    End If 
Next cell 

Application.CutCopyMode = False 
Range("A1").Select 

End Sub