将部分行从一个工作表复制到另一个工作表，然后对结果进行排序

Question

对VBA有点新意，所以感谢任何帮助，我试图将数据从一个工作表中的行复制到另一个工作表，删除空行并将列“V”中的数据从最大到最小排序。复制和粘贴很好，但是当我排序时，它会在“Winning”工作表的顶部留下空白行，而在底部留下已排序的数据。

排序前：

Sub CreateListOfTeams()

'Copy the data
Sheets("Team").Range("AB4:AW301").Copy
'Activate the destination worksheet
Sheets("Winning").Activate
'Select the target range
Range("A2").Select
'Paste in the target destination
ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats

Application.CutCopyMode = False

Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A1:V" & lastrow).Sort key1:=Range("V1:V" & lastrow), _
order1:=xlDescending, Header:=xlYes

End Sub

使用上面的代码排序后：

Answer 1

注意：如果您不使用Activate表格（＆＃34;获奖＆＃34;）以及稍后Select范围内，情况会更好

Option Explicit

Sub CreateListOfTeams()

'Copy data
Sheets("Team").Range("AB4:AW301").Copy

With Sheets("Winning")
    .Range("A2").PasteSpecial xlPasteValuesAndNumberFormats

    Application.CutCopyMode = False

    Dim LastRow As Long
    Dim Rng As Range, i As Long

    LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    Application.ScreenUpdating = False
    ' clear all blank rows
    For i = LastRow To 2 Step -1
        If WorksheetFunction.CountA(.Range("A" & i & ":V" & i)) = 0 Then .Rows(i).Delete
    Next i
    Application.ScreenUpdating = True

    LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row ' find last row after removal of blank rows
    Set Rng = .Range("A1:V" & LastRow) ' set the filter range
    Rng.Sort key1:=.Range("V1:V" & LastRow), _
            order1:=xlDescending, Header:=xlYes
End With

End Sub