Tilpase makro

Er der nogen der kan ændre nedenstående makro så den kopier "Ranges" istedet for rækker.

Private Sub CommandButton1_Click()
    Dim mpRow As Long
    Dim i As Long
   
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Select  Case .List(i)
                   
                Case "Delta": mpRow = 4
                   
                Case "Alfa": mpRow = 8
                   
                Case "Eta": mpRow = 12
                Case "Gamma": mpRow = 16
                   
                Case "Omega": mpRow = 20
                End Select
               
                Worksheets("vj").Rows(mpRow).Copy
               
                With Worksheets("Sheet1")
                    With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
                       
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteComments
                    End With
                End With
            End If
        Next i
    End With
   
End Sub