从一张纸复制到另一张

我正在尝试根据列值复制我的数据。 如果R栏无效，则应将所有信息从sheet1复制到sheet2。

我有下面的代码运行。 由于某些原因，它不会复制我的sheet1的最后两行。 我在sheet1中有551行，并且有551行的列R是无效的。 它只检查到548行，并跳过最后一行而不移动它们。

有人可以帮我解决这个问题

Sub Tab() Dim cell As Range Dim nextrow As Long Dim a As Double Application.ScreenUpdating = False ' get the count of rows in column r a = Sheets("sheet1").Cells(Rows.count, "R").End(xlUp).Row MsgBox (a) For Each cell In Sheets("sheet1").Range("R5:R" & a) ' if the cell in column R has invalid, then copy the entire row to another sheet If cell.Value = "Invalid" Then nextrow = Application.WorksheetFunction.CountA(Sheets("sheet2").Range("R:R")) Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1) End If Next Application.ScreenUpdating = True End Sub 

Answer 1

代替

 Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1) 

尝试

 Sheets("sheet1").Rows(cell.Row).Copy Destination:=Sheets("sheet2").Range("A" & nextrow + 1) 

你的代码可以写成

 Sub Demo() Dim cell As Range Dim nextrow As Long, a as Long Dim srcSht As Worksheet, destSht As Worksheet Application.ScreenUpdating = False Set srcSht = ThisWorkbook.Sheets("Sheet3") Set destSht = ThisWorkbook.Sheets("Sheet6") nextrow = Application.WorksheetFunction.CountA(destSht.Range("R:R")) With srcSht a = .Cells(.Rows.Count, "R").End(xlUp).Row MsgBox a For Each cell In .Range("R5:R" & a) ' if the cell in column R has invalid, then copy the entire row to another sheet If cell.Value = "Invalid" Then .Rows(cell.Row).Copy Destination:=destSht.Range("A" & nextrow + 1) nextrow = nextrow + 1 End If Next End With Application.ScreenUpdating = True End Sub 

而不是逐行粘贴数据，你也可以使用UNION 。

Answer 2

我不会涉及variables和方法（每个人都有自己的脚本）。 我会根据你的基本代码作出回应，希望你的理解是清楚的。

 Sub Tab() Dim cell As Range Dim nextrow As Long Dim a As Double Application.ScreenUpdating = False ' get the count of rows in column r a = Sheets("sheet1").Cells(Rows.count, "R").End(xlUp).Row MsgBox (a) 'This is assuming that you will always populate starting from the first row Range("A1") in Sheet2 nextrow = 1 For Each cell In Sheets("sheet1").Range("R5:R" & a) ' if the cell in column R has invalid, then copy the entire row to another sheet If cell.Value = "Invalid" Then 'Use the EntireRow function to copy the whole row to the Sheet2. 'During the next iteration, it will +1 to nextrow, so the next record will be copied to Range("A2"), next Range("A3") and so forth. cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("a" & nextrow) nextrow = nextrow + 1 End If Next Application.ScreenUpdating = True End Sub