复制部分行从一个表到另一个，然后排序结果

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表望而却步（它的更好“获胜”）和后来的Select r安格。

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