vba - Excel宏代码每隔第二行跳过一次

Question

下面的代码是获取员工姓名(A 列)并将该行的范围(“A:J”)放入该员工的新工作表中，如果他们没有工作表，则创建一个并添加广告标题。然而，它每隔一行就跳过一次，这导致它扫描姓名的行和复制的行不同(即:员工进入了错误的工作表，并且只有 1/2 得到了移动)任何帮助都会很棒

Set rngEmpSales = wsSales.Range("A2", wsSales.Range("A" & Rows.Count).End(xlUp).Address)
Dim wsSales As Worksheet, wsDesSales As Worksheet
Set wsSales = ThisWorkbook.Sheets("Sales")
Dim SalesCount as Range
    For Each SalesCount In rngEmpSales
                On Error Resume Next
                Set wsDesSales = ThisWorkbook.Sheets(Trim(SalesCount.Value))
                On Error GoTo 0
                If wsDesSales Is Nothing Then
                   Set wsDesSales = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                    wsDesSales.Name = SalesCount.Value
                End If
                SalesCount(1 - (SalesCount.Row - 1)).Range("A1:J1").Copy wsDesSales.Range("K2")
                SalesCount.Range("A" & SalesCount.Row & ":J" & SalesCount.Row).Copy wsDesSales.Range("K" & Rows.Count).End(xlUp).Offset(1, 0)
                Set wsDesSales = Nothing
            End If
    Next SalesCount

Answer 1

这就是你正在尝试的吗？ (未经测试)

Sub Sample()
    Dim wsSales As Worksheet, wsDesSales As Worksheet
    Dim rngEmpSales As Range, SalesCount As Range
    Dim shName As String
    Dim lRow As Long, i As Long

    Set wsSales = ThisWorkbook.Sheets("Sales")

    With wsSales
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rngEmpSales = .Range("A2:A" & lRow)

        For i = 2 To lRow
            shName = Trim(.Range("A" & i).Value)
            On Error Resume Next
            Set wsDesSales = ThisWorkbook.Sheets(shName)
            On Error GoTo 0

            If wsDesSales Is Nothing Then
                Set wsDesSales = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsDesSales.Name = shName
            End If

            .Range("A1:J1").Copy wsDesSales.Range("K2")
            .Range("A" & i & ":J" & i).Copy wsDesSales.Range("K" & _
                                            wsDesSales.Rows.Count).End(xlUp).Offset(1, 0)

            Set wsDesSales = Nothing
        Next i
    End With
End Sub