我看了你的代码和需求，问题主要出在这几个地方：

• staffAverage 过程只是选中了数据范围，但完全没执行复制到Sheet3的操作
• 依赖Select操作不仅效率低，还容易因为活动工作表切换出问题
• 没处理avgRow不是整数的情况（比如总数据行没法被9整除时，会有剩余行没人处理）
• 引用Cells时没指定工作表，大概率会导致范围引用错误

下面是修改后的完整代码，我会一步步说明关键改动：

Option Explicit

Sub runAll()
    Call fltrColumns
End Sub

Sub fltrColumns()
    Dim lastRowSheet1 As Long
    Dim dataRows As Long ' 实际需要分配的数据行数（去掉表头）
    Dim avgRow As Long
    Dim remainder As Long
    
    ' 清空Sheet2旧数据，同时清空Sheet3的旧数据（保留表头）
    Worksheets("Sheet2").Cells.ClearContents
    Worksheets("Sheet3").Range("A2:L" & Worksheets("Sheet3").Rows.Count).ClearContents
    
    ' 获取Sheet1中E列最后一行数据的行号（假设E1是表头）
    lastRowSheet1 = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
    ' 计算实际数据行数（去掉表头行）
    dataRows = lastRowSheet1 - 1
    
    If dataRows <= 0 Then
        MsgBox "没有可分配的数据！"
        Exit Sub
    End If
    
    ' 计算每个员工平均分配的行数，以及剩余未分配的行数
    avgRow = Int(dataRows / 9)
    remainder = dataRows Mod 9
    
    ' 将Sheet1指定列复制到Sheet2（和你原逻辑一致，优化了写法）
    With Worksheets("Sheet2")
        .Range("A1:A" & dataRows + 1).Value = Worksheets("Sheet1").Range("E1:E" & lastRowSheet1).Value
        .Range("B1:B" & dataRows + 1).Value = Worksheets("Sheet1").Range("F1:F" & lastRowSheet1).Value
        .Range("C1:C" & dataRows + 1).Value = Worksheets("Sheet1").Range("B1:B" & lastRowSheet1).Value
        .Range("D1:D" & dataRows + 1).Value = Worksheets("Sheet1").Range("A1:A" & lastRowSheet1).Value
        .Range("E1:E" & dataRows + 1).Value = Worksheets("Sheet1").Range("G1:G" & lastRowSheet1).Value
        .Range("F1:F" & dataRows + 1).Value = Worksheets("Sheet1").Range("H1:H" & lastRowSheet1).Value
        .Range("G1:G" & dataRows + 1).Value = Worksheets("Sheet1").Range("I1:I" & lastRowSheet1).Value
        .Range("H1:H" & dataRows + 1).Value = Worksheets("Sheet1").Range("L1:L" & lastRowSheet1).Value
        .Range("I1:I" & dataRows + 1).Value = Worksheets("Sheet1").Range("M1:M" & lastRowSheet1).Value
        .Range("J1:J" & dataRows + 1).Value = Worksheets("Sheet1").Range("J1:J" & lastRowSheet1).Value
        .Range("K1:K" & dataRows + 1).Value = Worksheets("Sheet1").Range("C1:C" & lastRowSheet1).Value
        .Range("L1:L" & dataRows + 1).Value = Worksheets("Sheet1").Range("D1:D" & lastRowSheet1).Value
    End With
    
    ' 调用分配数据的过程，传入平均行数和余数
    AssignToStaff avgRow, remainder, dataRows
End Sub

Sub AssignToStaff(ByVal avgRow As Long, ByVal remainder As Long, ByVal totalDataRows As Long)
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim startRow As Long
    Dim endRow As Long
    Dim staffNum As Long
    
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")
    
    startRow = 2 ' 从Sheet2的第2行开始（因为第1行是表头）
    
    For staffNum = 1 To 9
        ' 处理余数：前remainder个员工多分配1行，保证分配公平
        If staffNum <= remainder Then
            endRow = startRow + avgRow
        Else
            endRow = startRow + avgRow - 1
        End If
        
        ' 防止超出总数据行范围
        If endRow > totalDataRows + 1 Then
            endRow = totalDataRows + 1
        End If
        
        ' 直接复制Sheet2的指定范围到Sheet3，完全不需要Select操作
        ws2.Range(ws2.Cells(startRow, 1), ws2.Cells(endRow, 12)).Copy _
            Destination:=ws3.Range("A" & ws3.Rows.Count).End(xlUp).Offset(1)
        
        ' 更新下一个员工的起始行
        startRow = endRow + 1
        
        ' 如果已经分配完所有数据，提前退出循环
        If startRow > totalDataRows + 1 Then
            Exit For
        End If
    Next staffNum
    
    MsgBox "数据分配完成！"
End Sub

关键改动说明： #

• 修复数据行数计算：原代码用Offset(-1)可能错误排除最后一行数据，现在明确计算去掉表头后的实际数据行数，避免遗漏。
• 处理余数分配：当总数据行不能被9整除时，把多余的行平均分给前几个员工，保证分配公平。
• 抛弃Select操作：直接通过工作表对象引用范围并复制，不仅效率更高，还能避免因活动工作表切换导致的错误。
• 指定工作表的Cells引用：所有Cells都加上工作表对象前缀（比如ws2.Cells），确保引用的是Sheet2的单元格，不会出错。
• 清空旧数据：每次运行前清空Sheet2和Sheet3的旧数据（保留Sheet3表头），避免数据残留。

你直接替换原代码，运行runAll宏就能完成从Sheet1提取数据到Sheet2，再分配到Sheet3的完整流程了。

内容的提问来源于stack exchange，提问作者C.Nug