VBA Copy a Varying Number of Whole Rows

I have a workbook that will have information about different users and am trying to copy the top users in different categories to another sheet.

Right now, I have my macro set to go into the worksheet and sort the workbook based on the criteria I am interested in. I have the number of "top users" on a different sheet, and I want to be able to select the number of rows that corresponds to the number of top users, copy it, and paste it into another sheet.

For example, one of the categories is Questions Asked. For a specific date, there were 49 top question askers (this value is given in cell F31 on the sheet "Question Distribution"). In the sheet where all the data is, "Daily Activity," I have the macro sort the question category, and then I want to select the top 49 rows, copy the information in those rows, and paste them to a new sheet "Top Questions". But should the value in cell F31 change, I want it to select that many rows instead.

Is this possible?

Submit a copy of your workbook.

As it contains sensitive information, I cannot. I'll see if I can put together a similar one. But isn't it possible to answer this without the actual workbook?

I'm basically looking to select a number of rows [such as with rows("2:50").select ] except instead of the range being 2:50, it being 2: (the value given in cell F31 on a different worksheet).

Possible to answer? Yes. Do I want to take the time to create a worksheet matching all the parameters you put in place so I can test the code to make sure it works? No.

So with this sample workbook, I want to be able to have the macro go to the Activity sheet, sort descending by questions, and then select rows 2:The value given by cell D3 in the Top Users sheet and then paste those rows to the Top Questions sheet.

Similarly, I will want it to sort descending by answers, select rows 2:The value given by cell D4 in the Top users sheet, and paste those into the Top Answers sheet.

Etc etc

Try this:

Sub Main_Sort()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Activity")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Top Users")
Dim ws3 As Worksheet:   Set ws3 = Sheets("Top Question")
Dim ws4 As Worksheet:   Set ws4 = Sheets("Top Answer")
Dim ws5 As Worksheet:   Set ws5 = Sheets("Top Chat")
Dim ws6 As Worksheet:   Set ws6 = Sheets("Top DM")
Dim ws7 As Worksheet:   Set ws7 = Sheets("Top MG")
Dim ws8 As Worksheet:   Set ws8 = Sheets("Top MR")
Dim lastrow As Long, rowCount As Long

Application.ScreenUpdating = False

lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'same code just modified for each sort parameter
rowCount = ws2.Range("D3").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("B2:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rowCount = ws2.Range("D4").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("C2:C" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws4.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rowCount = ws2.Range("D5").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("D2:D" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws5.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rowCount = ws2.Range("D6").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("E2:E" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws6.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rowCount = ws2.Range("D7").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("F2:F" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws7.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rowCount = ws2.Range("D8").Value
ws1.Sort.SortFields.Clear
ws1.Sort.SortFields.Add Key:=Range("G2:G" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws1.Sort
    .SetRange Range("A1:H" & lastrow)
    .Header = xlYes
    .Apply
End With
ws1.Range("A2:A" & rowCount).EntireRow.Copy Destination:=ws8.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = True

End Sub

Seems to work great! Thanks so much. The range("D3").value command is the command I was really looking for. Pretty neat stuff