在复制/粘贴sheet1的前50个结果之前,我需要我的宏来清除sheet2。我能够根据特定条件找到有关如何从sheet1复制/粘贴到sheet2的答案,但无法找到有关如何仅选择前50个结果和清除sheet2中内容的任何内容。任何帮助深表感谢。
Option Explicit
Sub Button1_Click()
Dim sRange As Range
Dim sRow As Long, dRow As Long, lastRow As Long
Dim Column As Range
Dim dst As Worksheet, src As Worksheet
Dim sCount As Long
Set dst = Worksheets("Sheet2") 'Destination Worksheet
Set src = Worksheets("Sheet1") 'Source Worksheet
sRow = 2 'Starting source row
dRow = 1 'Starting destination row
lastRow = src.Cells(src.Rows.Count, "A").End(xlUp).Row
sCount = 0
For sRow = sRow To lastRow
If Cells(sRow, 5).Value = "Value1" Then
src.Rows(sRow).Select 'Select entire row
Selection.Copy Destination:=dst.Rows(dRow) 'copy to destination worksheet
sCount = sCount + 1
dRow = dRow + Selection.Rows.Count 'Move down by number of rows in selection
ElseIf Cells(sRow, 5).Value = "Value2" Then
src.Rows(sRow).Select 'Select entire row
Selection.Copy Destination:=dst.Rows(dRow) 'copy to destination worksheet
sCount = sCount + 1
dRow = dRow + Selection.Rows.Count 'Move down by number of rows in selection
ElseIf Cells(sRow, 5).Value = "Value3" Then
src.Rows(sRow).Select 'Select entire row
Selection.Copy Destination:=dst.Rows(dRow) 'copy to destination worksheet
sCount = sCount + 1
dRow = dRow + Selection.Rows.Count 'Move down by number of rows in selection
ElseIf Cells(sRow, 5).Value = "Value4" Then
src.Rows(sRow).Select 'Select entire row
Selection.Copy Destination:=dst.Rows(dRow) 'copy to destination worksheet
sCount = sCount + 1
dRow = dRow + Selection.Rows.Count 'Move down by number of rows in selection
ElseIf Cells(sRow, 5).Value = "Value5" Then
src.Rows(sRow).Select 'Select entire row
Selection.Copy Destination:=dst.Rows(dRow) 'copy to destination worksheet
sCount = sCount + 1
dRow = dRow + Selection.Rows.Count 'Move down by number of rows in selection
src.Range("A1").Select
End If
Next sRow
MsgBox sCount & " Values Selected: Transfer Done"
Set src = Nothing
Set dst = Nothing
End Sub