将数据移动到另一个工作表和特定的单元格不按预期工作

我在一张纸上logging了我的数据（“PBT”）。 有不同的数据范围需要去不同的工作表。 我目前的代码将数据移动到我想要的工作表; 然而，它开始把数据放入A4，然后将下一行放入A3，A2，然后删除其他任何东西。 我希望它从A4下来，我不知道我在做什么错。

这里是代码：

Sub Move_Data() 'Moves data to set worksheets Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'We use the ActiveSheet but you can replace this with 'Sheets("MySheet")if you want With Sheets("PBT") 'We select the sheet so we can change the window view .Select 'If you are in Page Break Preview Or Page Layout view go 'back to normal view, we do this for speed ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView 'Turn off Page Breaks, we do this for speed .DisplayPageBreaks = False 'Set the first and last row to loop through Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 'We loop from Lastrow to Firstrow (bottom to top) For Lrow = Lastrow To Firstrow Step -1 'We check the values in the A column in this example With .Cells(Lrow, "A") If Not IsError(.Value) Then If Right(.Value, 7) >= 30001 And Right(.Value, 7) <= 32500 Then .EntireRow.Cut Sheets("WTH").Range("A4").End(xlUp).Offset(1) 'in Column A, case sensitive. End If End With Next Lrow End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub 

Answer 1

尝试这个。 你的For Loop从最后一行倒退到第一行。 我拿出了Step-1，让它增加而不是减less，我翻转了Firstrow和Lastrow，所以它从第一排开始，停在Lastrow上。

Sheet1的初始状态:( Sheet2是空的）

代码之后Sheet1的状态：

代码之后Sheet2的状态：

  Sub Move_Data() 'Moves data to set worksheets Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long Dim num_of_entries As Integer With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With num_of_entries = 0 'We use the ActiveSheet but you can replace this with 'Sheets("MySheet")if you want With Sheets("Sheet1") 'We select the sheet so we can change the window view 'If you are in Page Break Preview Or Page Layout view go 'back to normal view, we do this for speed 'Turn off Page Breaks, we do this for speed 'Set the first and last row to loop through Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 'We loop from Lastrow to Firstrow (bottom to top) For Lrow = Firstrow To Lastrow 'We check the values in the A column in this example With .Cells(Lrow, "A") If Not IsError(.Value) Then If Right(.Value, 7) >= 30001 And Right(.Value, 7) <= 32500 Then .EntireRow.Cut Sheets("Sheet2").Range("A4").Offset(num_of_entries) num_of_entries = num_of_entries + 1 'in Column A, case sensitive. End If End If End With Next Lrow End With 'ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub 

Answer 2

这是可以解决一些问题的代码版本。 1.通过循环前进，以便知道在另一个表格中写入值的位置2.通过前进，必须确保在切出一行时保持在同一行，并且不要超出结尾现在更短的名单。

我在评论中标注了我用*****更改的行。

 Sub Move_Data() 'Moves data to set worksheets '**** We dont need Firstrow anymore '**** Dim Firstrow As Long '**** Use Targetrow for driving where the move should be to Dim TargetRow as Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'We use the ActiveSheet but you can replace this with 'Sheets("MySheet")if you want With Sheets("PBT") 'We select the sheet so we can change the window view .Select 'If you are in Page Break Preview Or Page Layout view go 'back to normal view, we do this for speed ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView 'Turn off Page Breaks, we do this for speed .DisplayPageBreaks = False 'Set the first and last row to loop through '**** Assign to Lrow as we will use While loop Lrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row '**** New variable for reference in target sheet TargetRow = 5 ' ***** We loop forward now Do While Lrow <= Lastrow 'We check the values in the A column in this example With .Cells(Lrow, "A") If Not IsError(.Value) Then If Right(.Value, 7) >= 30001 And Right(.Value, 7) <= 32500 Then 'in Column A, case sensitive. ' **** Use Target Row to determine destination range .EntireRow.Cut Sheets("WTH").Range("A" & TargetRow) ' **** increment the target row for next move. TargetRow = TargetRow + 1 ' **** As we removed one row, our last row is one less now Lastrow = Lastrow - 1 ' *** Counter the increment to the row, as we have the new ' *** row already at the position where we cut one away Lrow = Lrow - 1 End If End If ' **** Increment Lrow = Lrow + 1 End With '**** Loop End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub