如何让一个macros把最后一个相关的数据从一个标签拖到另一个标签？

我有一些正在相互合作的macros将数据分类并整理到相关的选项卡中，并且似乎遇到了一个问题，一旦数据到达行2500左右，macros就不能正常工作。

第一个运行的是一个sorting（Sort）macros，它接收所有数据并将其分类到我根据其类别调用“macrolist”的选项卡中的相关列中：

Dim LastRow As Integer ', LastCell as String ' ' This is the visual basic to sort the data sheet for excel 2003 Range("B2:S5002").Select Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("B3") _ , Order2:=xlAscending, Key3:=Range("E3"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ xlSortNormal 'Go to the macrolist sheet and run each filter macro Sheets("macrolist").Select Application.Run "kittensfilter" Application.Run "catsfilter" Application.Run "housecatsfilter" Application.Run "lionsfilter" Application.Run "mountainlionsfilter" Application.Run "wbfilter" Application.Run "triconfilter" Application.Run "schedulefilter" 'go back to the data sheet and select the last entered job Sheets("data").Select LastRow = Worksheets("data").Range("U2").Value Cells(LastRow, 2).Select 'selection of a range 'lastCell = Range(Cells(LastRow, 1), Cells(LastRow, 2)).Address 'Range(lastCell).Select 'enter a timestamp Worksheets("data").Range("C1") = Time Worksheets("data").Range("D1") = Date 

我遇到的两个问题是小猫和小狗filter; 它似乎是什么时候到达数据选项卡上的某一点（大约第2500行），他们只是停止前进与符合标准的新信息。 我知道这应该发生在行5002，根据我的代码，但它似乎随机发生在前面的点。

以下是两个filter：

 Sub kittensfilter() Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String Dim MyRow As Integer, LastDataRow As Integer, DataRng As String Dim CritRow As Integer, CritRng As String, RightCol As Integer Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer ' the source data MUST be in a worksheet called 'Data' ' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS *** ' cell Data!"?" contains the last row number of data LastDataRow = Worksheets("data").Range("U2").Value DataRng = "data!A2:S2" ' range of column headers for Data table CritRng = "macrolist!C3:U11" ' range of cells for Criteria table ResultsRng = "macrolist!C13:U13" ' range of headers for Results table MaxResults = 214 ' any value higher than the number of possible results ' **************** END OF DECLARATIONS ********************* ' fix the data range to incorporate the last row TopRow = Worksheets("data").Range(DataRng).Row LeftCol = Worksheets("data").Range(DataRng).Column RightCol = LeftCol + Worksheets("data").Range(DataRng).Columns.Count - 1 DataRng = "data!" & Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address ' fix the results range to incorporate the last row TopRow = Worksheets("macrolist").Range(ResultsRng).Row LeftCol = Worksheets("macrolist").Range(ResultsRng).Column RightCol = LeftCol + Worksheets("macrolist").Range(ResultsRng).Columns.Count - 1 ResultsRng = "macrolist!" & Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults, RightCol)).Address Range(ResultsRng).ClearContents ' clear any previous results but not headers ResultsRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(MaxResults, RightCol)).Address ' fix the criteria range and identify the last row containing any items TopRow = Worksheets("macrolist").Range(CritRng).Row BottomRow = TopRow + Worksheets("macrolist").Range(CritRng).Rows.Count - 1 LeftCol = Worksheets("macrolist").Range(CritRng).Column RightCol = LeftCol + Worksheets("macrolist").Range(CritRng).Columns.Count - 1 CritRow = 0 For MyRow = TopRow + 1 To BottomRow For MyCol = LeftCol To RightCol If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow Next Next If CritRow = 0 Then MsgBox "No Criteria detected", "MeadInKent" Else CritRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address 'Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng Worksheets("data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _ Unique:=False End If 'Range("A5").Select Worksheets("black").Range("f4") = Time Worksheets("black").Range("f5") = Date End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub Sub catsfilter() Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String Dim MyRow As Integer, LastDataRow As Integer, DataRng As String Dim CritRow As Integer, CritRng As String, RightCol As Integer Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer ' the source data MUST be in a worksheet called 'Data' ' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS *** ' cell Data!"?" contains the last row number of data LastDataRow = Worksheets("data").Range("U2").Value DataRng = "data!A2:S2" ' range of column headers for Data table CritRng = "macrolist!BN3:CF11" ' range of cells for Criteria table ResultsRng = "macrolist!BN13:CF13" ' range of headers for Results table MaxResults = 214 ' any value higher than the number of possible results ' **************** END OF DECLARATIONS ********************* ' fix the data range to incorporate the last row TopRow = Worksheets("data").Range(DataRng).Row LeftCol = Worksheets("data").Range(DataRng).Column RightCol = LeftCol + Worksheets("data").Range(DataRng).Columns.Count - 1 DataRng = "data!" & Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address ' fix the results range to incorporate the last row TopRow = Worksheets("macrolist").Range(ResultsRng).Row LeftCol = Worksheets("macrolist").Range(ResultsRng).Column RightCol = LeftCol + Worksheets("macrolist").Range(ResultsRng).Columns.Count - 1 ResultsRng = "macrolist!" & Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults, RightCol)).Address Range(ResultsRng).ClearContents ' clear any previous results but not headers ResultsRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(MaxResults, RightCol)).Address ' fix the criteria range and identify the last row containing any items TopRow = Worksheets("macrolist").Range(CritRng).Row BottomRow = TopRow + Worksheets("macrolist").Range(CritRng).Rows.Count - 1 LeftCol = Worksheets("macrolist").Range(CritRng).Column RightCol = LeftCol + Worksheets("macrolist").Range(CritRng).Columns.Count - 1 CritRow = 0 For MyRow = TopRow + 1 To BottomRow For MyCol = LeftCol To RightCol If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow Next Next If CritRow = 0 Then MsgBox "No Criteria detected", "MeadInKent" Else CritRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address 'Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng Worksheets("data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _ Unique:=False End If 'Range("A5").Select Worksheets("finished").Range("C4") = Time Worksheets("finished").Range("C5") = Date End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub 

这些都采取“macrolist”选项卡中提供的信息，并将其复制到各自的“小猫”和“猫”选项卡。

我认为主要的问题是sortingfunction，但我不知道我应该改变，以使其能够继续按需要执行。 我已经尝试增加/减less范围，但是它们似乎没有效果。

任何帮助表示赞赏。