Kopieren Sie Teilzeilen von einem Blatt zu einem anderen und sortieren Sie dann die Ergebnisse

Question

Art von neu zu VBA so schätzen jede Hilfe, ich versuche Daten aus Zeilen in einem Arbeitsblatt zu einem anderen zu kopieren, entfernen Sie die leeren Zeilen und sortieren Sie die Daten in Spalte "V" vom größten zum kleinsten. Das Kopieren und Einfügen ist in Ordnung, aber wenn ich es sortiere, bleiben die leeren Zeilen am oberen Rand des "Gewinn" -Blattes und die sortierten Daten am unteren Rand.

Vor dem Sortieren:

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 

Nach Sortierung mit obigem Code:

Answer 1

Hinweis: es ist besser, wenn Sie bleiben weg von der Nutzung Activate Sheets ("Winning") und später auf Select der r Ange.

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