macros在x行后停止工作

我有这个代码完美运行循环通过多个执行工作簿复制和粘贴到这个主工作簿。 它会看到，直到各自的执行工作簿的最后一行

readLastCellNameSheet = ExecutiveWorkBook.Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Row 

然后粘贴到Masterworkbook。 但是，当我插入我的4000行数据时，只有3000行插入此主工作簿。 以下是供参考的完整代码。 我有不同行的多个执行工作簿需要复制到主工作簿。 一切工作正常，直到停在第3000行。有什么build议吗？

 Sub UpdateDate_Click() Dim readLastCell As Long Dim readLastCellNameSheet As Long Dim billNumber Dim SheetName As String Dim billNumberNamesheet As Long Dim ExecutiveWorkBookPath As String Dim excelFilePath Dim ExecutiveWorkBook As Workbook Dim MainTemplate As String MainTemplate = ThisWorkbook.Name ThisWorkbook.Sheets("Master").Unprotect "12345+" ThisWorkbook.Worksheets("Master").Range("R1:AV20000").Locked = False ThisWorkbook.Worksheets("Master").Range("R4:AV20000").Value = "" 'ChDir Defaulth path excelFilePath = Application.ActiveWorkbook.Path + "\" Application.EnableEvents = False strFilename = Dir(excelFilePath & "\*xlsm") Do While strFilename <> "" 'Set variable equal to opened workbook If InStr(strFilename, "Executive") > 0 Then Set ExecutiveWorkBook = Workbooks.Open(excelFilePath & strFilename, ReadOnly:=True) ExecutiveWorkBook.Worksheets("Summary").Unprotect "12345+" ExecutiveWorkBook.Worksheets("Summary").Range("A1:Q22000").Locked = False readLastCell = ThisWorkbook.Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row readLastCellNameSheet = ExecutiveWorkBook.Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Row For x = 4 To readLastCellNameSheet cell = "A" & x billNumber = ThisWorkbook.Worksheets("Master").Range(cell).Value If Len(billNumber) = 0 Then Exit For For N = 4 To readLastCellNameSheet cell = "A" & N billNumberNamesheet = ExecutiveWorkBook.Worksheets("Summary").Range(cell).Value If Len(billNumberNamesheet) = 0 Then Exit For If billNumberNamesheet = billNumber Then cell = "R" & N & ":" & "AV" & N copycell = "R" & x & ":" & "AV" & x ExecutiveWorkBook.Worksheets("Summary").Range(cell).Copy ThisWorkbook.Worksheets("Master").Range(copycell).PasteSpecial Paste:=xlPasteAll End If Next N Next x ExecutiveWorkBook.Worksheets("Summary").Range("A1:Q22000").Locked = True ExecutiveWorkBook.Sheets("Summary").Protect "12345+", True, True 'ThisWorkbook.Worksheets("Master").Range("R1:AV20000").Locked = True 'ThisWorkbook.Sheets("Master").Protect "12345+", True, True ' CLOSE THE SOURCE FILE. ExecutiveWorkBook.Close savechanges:=False ' FALSE - DON'T SAVE THE SOURCE FILE. Else End If 'to get next file name strFilename = Dir Loop Application.EnableEvents = True MsgBox "Updated Succesully" End Sub