Excel VBA：为什么复制/粘贴覆盖其他数据，但只有60,000行后？

我已经编写了代码来遍历工作簿的文件夹，并从工作表中提取某些列，然后将数据粘贴到单个工作表上

这段代码运行良好，直到第29个工作簿，我的ExtractedColumns工作表底部粘贴的数据被粘贴在顶部。 其余的工作簿也发生了同样的情况 – 它会覆盖顶部的数据。

在60,000行已被粘贴到ExtractedColumns工作表，远低于Excel工作表的行号的限制之后，会发生此问题。

我无法弄清楚为什么会发生这种情况，特别是因为它对于前28个工作簿来说工作的很好。

这里是我的代码复制和粘贴（我不张贴的代码来循环通过该文件夹并打开每个工作簿，因为我觉得代码不会导致问题）：

Sub extract() Dim curr As Range Dim cell As Range Dim lastRow As Variant Dim n As Long Dim found As Boolean Dim FirstRow As Range Dim wbOpen As Object found = False Set wbOpen = Workbooks("ExtractedColumns") 'finds where data starts For i = 3 To 50 If Not IsEmpty(Cells(i, "E")) Then Exit For End If Next ' Next 'Par B name: if there is a header with one of these names, then it extracts those For Each curr In Range("A" & i, "Z" & i) If InStr(1, curr.Value, "Protein name", vbTextCompare) > 0 Or InStr(1, curr.Value, "description", vbTextCompare) > 0 Or InStr(1, curr.Value, "Common name", vbTextCompare) > 0 Then lastRow = wbOpen.Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=wbOpen.Sheets("Sheet1").Range("D" & lastRow + 1) found = True Exit For End If Next 'If there isn't a header with one of the above names, then see if there is one with the name "protein" If Not found Then For Each curr In Range("A" & i, "Z" & i) If InStr(1, curr.Value, "protein", vbTextCompare) > 0 Then lastRow = wbOpen.Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=wbOpen.Sheets("Sheet1").Range("D" & lastRow + 1) Exit For End If Next End If 'Par B accession For Each curr In Range("A" & i, "Z" & i) If InStr(1, curr.Value, "accession", vbTextCompare) > 0 Or InStr(1, curr.Value, "Uniprot", vbTextCompare) > 0 Or InStr(1, curr.Value, "IPI") > 0 Then lastRow = wbOpen.Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=wbOpen.Sheets("Sheet1").Range("E" & lastRow + 1) found = True Exit For End If Next 'Par B site For Each curr In Range("A" & i, "Z" & i) If (UCase(curr.Value) = "RESIDUE" Or UCase(curr.Value) = "POSITION" Or UCase(curr.Value) = "POSITIONS" Or InStr(1, curr.Value, "Positions within protein", vbTextCompare) > 0 Or InStr(1, curr.Value, "Position in peptide", vbTextCompare) Or InStr(1, curr.Value, "Site", vbTextCompare) > 0) And (InStr(1, curr.Value, "modification", vbTextCompare) = 0 And InStr(1, curr.Value, "ERK") = 0 And InStr(1, curr.Value, "class", vbTextCompare) = 0) Then lastRow = wbOpen.Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=wbOpen.Sheets("Sheet1").Range("G" & lastRow + 1) Exit For End If Next 'puts dashes in any blank cells in the columns (so spreadsheet isn't ragged) n = wbOpen.Sheets("Sheet1").UsedRange.Rows(wbOpen.Sheets("Sheet1").UsedRange.Rows.Count).Row For Each curr In wbOpen.Sheets("Sheet1").Range("D2:D" & n) If curr.Value = "" Then curr.Value = " - " Next For Each curr In wbOpen.Sheets("Sheet1").Range("E2:E" & n) If curr.Value = "" Then curr.Value = " - " Next For Each curr In wbOpen.Sheets("Sheet1").Range("G2:G" & n) If curr.Value = "" Then curr.Value = " - " Next 'puts "x" in first empty row (filename will go in column A in this row) n = wbOpen.Sheets("Sheet1").UsedRange.Rows(wbOpen.Sheets("Sheet1").UsedRange.Rows.Count + 1).Row For Each curr In wbOpen.Sheets("Sheet1").Range("D2:D" & n) If curr.Value = "" Then curr.Value = "x" Next For Each curr In wbOpen.Sheets("Sheet1").Range("E2:E" & n) If curr.Value = "" Then curr.Value = "x" Next For Each curr In wbOpen.Sheets("Sheet1").Range("G2:G" & n) If curr.Value = "" Then curr.Value = "x" Next End Sub 

Answer 1

如果你打开一些旧格式的工作簿（其中有65536行的限制），那么你的不合格Rows.Count

 lastRow = wbOpen.Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row 

正在使这条线相当于

 lastRow = wbOpen.Sheets("Sheet1").Cells(65536, "D").End(xlUp).Row 

因此，一旦在“ExtractedColumns”工作表中有超过65536行， End(xlUp)就会一直移动到文件的顶部，并可能将lastRow设置为1（除非在第一行下面有一些空单元D栏）。

那条线应该是

 lastRow = wbOpen.Sheets("Sheet1").Cells(wbOpen.Sheets("Sheet1").Rows.C‌​ount, "D").End(xlUp).Row 

总是限定Range ， Cells ， Rows等，除非你知道你想引用ActiveSheet 。