修复按销售员分类复制客户数据到指定行的VBA宏问题

原代码所有数据都从第39行开始粘贴，核心问题有两个：

• 计算粘贴行时，没有区分valid和非valid对应的两个独立区域，直接取整个A列的最后一行+1，导致两类数据都堆到了同一个区域末尾。
• 循环逻辑冗余，对每一行数据遍历所有工作表，既浪费资源又容易引发逻辑混乱。

以下是修复后的代码：

Sub ExtractClientsBySalesman()
    ' 声明变量
    Dim wsData As Worksheet
    Dim wsSalesman As Worksheet
    Dim lastRowData As Long
    Dim i As Long
    Dim salesmanName As String
    Dim pasteRowValid As Long
    Dim pasteRowInvalid As Long
    
    ' 绑定数据工作表
    Set wsData = ThisWorkbook.Sheets("data")
    
    ' 获取数据最后一行
    lastRowData = wsData.Cells(wsData.Rows.Count, "D").End(xlUp).Row
    
    ' 遍历所有客户数据行
    For i = 2 To lastRowData
        salesmanName = wsData.Cells(i, "L").Value
        
        ' 先判断对应销售员工作表是否存在
        On Error Resume Next
        Set wsSalesman = ThisWorkbook.Sheets(salesmanName)
        On Error GoTo 0
        
        ' 如果工作表存在，执行粘贴逻辑
        If Not wsSalesman Is Nothing Then
            ' 处理valid数据：从第10行开始找最后一行
            If wsData.Cells(i, "I").Value = "valid" Then
                ' 找A列从第10行开始的最后非空行，没有数据就用第10行
                pasteRowValid = wsSalesman.Cells(wsSalesman.Rows.Count, "A").End(xlUp).Row
                If pasteRowValid < 10 Then
                    pasteRowValid = 10
                Else
                    pasteRowValid = pasteRowValid + 1
                End If
                ' 复制数据
                With wsSalesman
                    .Cells(pasteRowValid, 1).Value = wsData.Cells(i, 1).Value
                    .Cells(pasteRowValid, 2).Value = wsData.Cells(i, 9).Value
                    .Cells(pasteRowValid, 3).Value = wsData.Cells(i, 42).Value
                    .Cells(pasteRowValid, 4).Value = wsData.Cells(i, 4).Value
                    .Cells(pasteRowValid, 5).Value = wsData.Cells(i, 14).Value
                    .Cells(pasteRowValid, 6).Value = wsData.Cells(i, 16).Value
                    .Cells(pasteRowValid, 7).Value = wsData.Cells(i, 40).Value
                    .Cells(pasteRowValid, 8).Value = wsData.Cells(i, 12).Value
                End With
            ' 处理非valid数据：从第39行开始找最后一行
            ElseIf wsData.Cells(i, "I").Value <> "valid" Then
                ' 找A列从第39行开始的最后非空行，没有数据就用第39行
                pasteRowInvalid = wsSalesman.Cells(wsSalesman.Rows.Count, "A").End(xlUp).Row
                If pasteRowInvalid < 39 Then
                    pasteRowInvalid = 39
                Else
                    pasteRowInvalid = pasteRowInvalid + 1
                End If
                ' 复制数据
                With wsSalesman
                    .Cells(pasteRowInvalid, 1).Value = wsData.Cells(i, 1).Value
                    .Cells(pasteRowInvalid, 2).Value = wsData.Cells(i, 9).Value
                    .Cells(pasteRowInvalid, 3).Value = wsData.Cells(i, 42).Value
                    .Cells(pasteRowInvalid, 4).Value = wsData.Cells(i, 4).Value
                    .Cells(pasteRowInvalid, 5).Value = wsData.Cells(i, 14).Value
                    .Cells(pasteRowInvalid, 6).Value = wsData.Cells(i, 16).Value
                    .Cells(pasteRowInvalid, 7).Value = wsData.Cells(i, 40).Value
                    .Cells(pasteRowInvalid, 8).Value = wsData.Cells(i, 12).Value
                End With
            End If
            ' 释放工作表对象
            Set wsSalesman = Nothing
        End If
    Next i
End Sub

关键修改点说明 #

• 精准区分粘贴区域：分别计算valid和非valid对应的粘贴行，确保valid数据从第10行开始，非valid从第39行开始，避免两类数据混在一起。
• 优化查找逻辑：直接根据L列的销售员名字定位对应工作表，不用遍历所有工作表，提升运行效率。
• 完善变量声明：显式声明所有变量，避免隐式声明导致的错误。
• 增加工作表存在性判断：防止因销售员名字对应工作表不存在而报错。

内容的提问来源于stack exchange，提问作者Laura_777