Excel 2010 VBA-未追加行

我正在Excel 2010中使用VBA创建一个宏，以基于DOB和状态单元格（都在同一工作簿中）将行从一张工作表移动到另一张工作表

宏根据“截止”日期检查DOB，如果行通过，则应将该行追加到TSP表并从表1中删除

如果未通过，则检查行的“状态”单元格是否存在状态表。如果是，则该行应追加到该图纸的末尾，并从图纸1中删除

如果行不满足这两个条件中的任何一个，只需手动检查它，因为它要么缺少数据，要么输入的数据不正确

除了将行追加到工作表之外，所有操作都正常工作。它只是简单地替换除OH表之外的表的最后一行，OH表出于任何原因都在工作

我的宏：

Sub Move()
'
' Move Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
' Declare and set variables
Dim CBL_DATE
Dim totalrows, c
Set tsp_sheet = Sheets("TSP")
Set people = Sheets("Sheet1")
CBL_DATE = DateAdd("yyyy", -59.5, Date)
' Find total number of people to move
totalrows = people.UsedRange.Rows.Count
' Step through each row
For Row = totalrows To 2 Step -1
    ' Do not do anything if row is 1
    If Row >= 2 Then
        ' Check for CBL cut off date and move to TSP sheet
        If Cells(Row, 3).Value < CBL_DATE Then
            tsp_sheet.Rows(tsp_sheet.UsedRange.Rows.Count + 1).Value = people.Rows(Row).Value
            people.Rows(Row).Delete
        Else
                ' Now we check for the state and if that worksheet exists, we copy to it and delete original
            If SheetExists(Cells(Row, 2).Value) Then
                Set st_sheet = Sheets(Cells(Row, 2).Value)
                c = st_sheet.UsedRange.Rows.Count + 1
                MsgBox Cells(Row, 2).Value & " " & c
                st_sheet.Rows(c).Value = people.Rows(Row).Value
                people.Rows(Row).Delete
            End If
        End If
    End If
Next Row
End Sub
' End Sub Move()

---

在缺少函数SheetExists（）的代码的情况下，我测试了您的代码

If SheetExists(Cells(Row, 2).Value) Then
    Set st_sheet = Sheets(Cells(Row, 2).Value)

借

列表是从下到上的，这很好，因为你删除（但不是唯一可能的方式）。与条件匹配的第一行是第4行，该行位于活页2的第2行，留下1行空白（因为+1）。这一空行#1为后续调用UsedRange带来了一些混乱，随后第#2行中的命中（日期条件）覆盖了第一个查找

顺便说一句，如果行>=2，则第1个

是多余的，因为

的sourrounding

设置了边界

我建议把整个潜艇重新编码一点

Sub Move1()
Dim SrcRng As Range, SrcIdx As Long
Dim TSPRng As Range, CtyRng As Range, TrgIdx As Long
Dim CblDate As Date

    Set SrcRng = Sheets("Sheet1").[A1] ' source sheet
    Set TSPRng = Sheets("Sheet2").[A1] ' target for date condition
    Set CtyRng = Sheets("Sheet2").[A1] ' target for country condition, preliminary set equal to TSP
    CblDate = DateAdd("yyyy", -59.5, Date)
    SrcIdx = 2                         ' 1st row is header row

    ' we stop on 1st blank in 1st column of SrcRng
    Do While SrcRng(SrcIdx, 1) <> ""
        If SrcRng(SrcIdx, 3) < CblDate Then
            ' copy to TSP sheet
            TrgIdx = GetIdx(TSPRng)
            SrcRng(SrcIdx, 1).EntireRow.Copy TSPRng(TrgIdx, 1)

            ' delete from source
            SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp

        ElseIf SrcRng(SrcIdx, 2) = "OH" Then    ' replace by your on condition re country
            ' here you would set CtyRng acc. to some algorithm

            ' copy to Country sheet
            TrgIdx = GetIdx(CtyRng)
            SrcRng(SrcIdx, 1).EntireRow.Copy CtyRng(TrgIdx, 1)

            ' delete from source
            SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp

        Else
            ' we don't increment after deletions, because all records move up anyhow
            SrcIdx = SrcIdx + 1

        End If

    Loop

End Sub

Function GetIdx(InRng As Range) As Long
' find row number of 1st empty row in 1st column of range InRng

    GetIdx = 1
    Do While InRng(GetIdx, 1) <> ""
        GetIdx = GetIdx + 1
    Loop

End Function

您能粘贴第四个索引级别使用的“SheetExists”功能吗？谢谢。。。。正如我所想；-）我想我的答案仍然有效。你的代码很棒，解决了我的问题，虽然我仍然不太明白是什么错了，但是欢迎来到编码的世界，对吗？。我已经修改了代码集StRng=Sheets（SrcRng（SrcIdx，2））[A1]TrgIdx=GetIdx（StRng），但现在我不断得到一个类型不匹配错误？为了澄清，SrcRng[2]列是States，应该等于工作簿中以相同缩写标记的相应状态表-如SrcRng[2]“OH”=“OH”工作表中的一样。然而，这意味着最终可能会有多达50个不同的表，这就是为什么我在准备移动单元格之前不拉动目标范围。如果这样做与一开始就拉所有工作表相比，并没有真正节省任何东西，我愿意接受建议。非常感谢您，只需稍作调整，就可以动态拉取正确的工作表进行放置。如果SheetExists（SrcRng（SrcIdx，2）），则设置StRng=wb.worksheets（CStr（SrcRng（SrcIdx，2））。[A1]@罗伯特·德博：为什么不把赏金颁给麦克？如果你觉得没有更好的答案和/或你的问题得到了满意的回答，你不必等待整整7天。我的错，我认为接受他的回答会自动获得赏金，而我周末去了，所以我现在已经获得了赏金。
If SheetExists(Cells(Row, 2).Value) Then
    Set st_sheet = Sheets(Cells(Row, 2).Value)

If Cells(Row, 2).Value = "OH" Then
    Set st_sheet = Sheets("Sheet2")

Sub Move1()
Dim SrcRng As Range, SrcIdx As Long
Dim TSPRng As Range, CtyRng As Range, TrgIdx As Long
Dim CblDate As Date

    Set SrcRng = Sheets("Sheet1").[A1] ' source sheet
    Set TSPRng = Sheets("Sheet2").[A1] ' target for date condition
    Set CtyRng = Sheets("Sheet2").[A1] ' target for country condition, preliminary set equal to TSP
    CblDate = DateAdd("yyyy", -59.5, Date)
    SrcIdx = 2                         ' 1st row is header row

    ' we stop on 1st blank in 1st column of SrcRng
    Do While SrcRng(SrcIdx, 1) <> ""
        If SrcRng(SrcIdx, 3) < CblDate Then
            ' copy to TSP sheet
            TrgIdx = GetIdx(TSPRng)
            SrcRng(SrcIdx, 1).EntireRow.Copy TSPRng(TrgIdx, 1)

            ' delete from source
            SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp

        ElseIf SrcRng(SrcIdx, 2) = "OH" Then    ' replace by your on condition re country
            ' here you would set CtyRng acc. to some algorithm

            ' copy to Country sheet
            TrgIdx = GetIdx(CtyRng)
            SrcRng(SrcIdx, 1).EntireRow.Copy CtyRng(TrgIdx, 1)

            ' delete from source
            SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp

        Else
            ' we don't increment after deletions, because all records move up anyhow
            SrcIdx = SrcIdx + 1

        End If

    Loop

End Sub

Function GetIdx(InRng As Range) As Long
' find row number of 1st empty row in 1st column of range InRng

    GetIdx = 1
    Do While InRng(GetIdx, 1) <> ""
        GetIdx = GetIdx + 1
    Loop

End Function

Sub test()
    Debug.Print ActiveSheet.UsedRange.Rows.Count
End Sub