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

Question

我的所有数据都在一张纸上（“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循环从最后一行倒退到第一行。我拿出Step - 1来增加而不是减少，我在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