在粘贴前50个结果之前清除Sheet2的宏

时间:2015-10-31 18:11:46

标签: excel vba excel-vba

在复制/粘贴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

0 个答案:

没有答案