具有下标超出范围错误的Excel VBA剪切和粘贴功能

Question

    Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1 As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

        endrow = mainsheet.Range("A" & mainsheet.Rows.Count).End(xlUp).Row

            For i = 25 To endrow
                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(Cells(i, "B"), Cells(i, "O")).Cut Destination:=subsheet.Range(Cells(i + 25, "B"), Cells(i + 25, "O")).Paste
                    mainsheet.Range(Cells(i, "B"), Cells(i, "O")).Delete '~~> if you want to delete
                    i = i + 1
                End If
            Next
    End With
End Sub

I would like to write a program with the below function

If Cell ("J" i) or Cell("L" i) or Cell("N" i) in Sheet1 is not empty where i equals to any integer

Then cut Cell("B" i) to Cell("O" i) in Sheet 1 to Cell("B" i+25) to Cell("O" i+25) in Sheet2 where i equals to any integer

However,my code was said to be out of range.

Why is it like so and how can i fix it?

Many thanks

    Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1  As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

        endrow = mainsheet.Range("A" & mainsheet.Rows.Count).End(xlUp).Row

        For i = endrow To 25 Step -1

                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Range(subsheet.Cells(i + 56, "B"), subsheet.Cells(i + 56, "O")).Paste
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Delete '~~> if you want to delete

                End If
            Next
    End With
End Sub

Latest Version:

        Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1  As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

        endrow = mainsheet.Range("A" & mainsheet.Rows.Count).End(xlUp).Row
        Bendrow = subsheet.Range("B" & mainsheet.Rows.Count).End(xlUp).Row + 1

        For i = endrow To 25 Step -1
                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Cells(Bendrow, "B")
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Delete '~~> if you want to delete
                    Bendrow = Bendrow + 1
                End If
            Next
    End With
End Sub

MainSheet Data

SubSheet Data

Answer 1

The problem was that the Destination parameter of Range.Copy and Range.Cut need to be a range. You have it set to the Paste method of a range.

Incorrect

mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Range(subsheet.Cells(i + 56, "B"), subsheet.Cells(i + 56, "O")).Paste

Correct

mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Cells(i + 56, "B")

I refactored you code using subrange. I think that it gives a much cleaner look.

Here are some different ways of defining the same range

Range(Cells(i,"A"),Cells(i,"O")) Cells(i,"A").Resize(1,15) Rows(i).Range ("A1:O1") Rows(i).Range ("A1:O1") Rows(i).Resize(1,15) Rows(2).Columns("A:O")

Sub CutandPaste()

    Dim i As Long
    Dim mainsheet As Worksheet
    Dim subsheet As Worksheet

    Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
    Set subsheet = ActiveWorkbook.Sheets("Sheet2")

    With mainsheet
        endrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = endrow To 25 Step -1
            If .Cells(i, "J") <> "" Or .Cells(i, "L") <> "" Or .Cells(i, "N") <> "" Then
                .Rows(i).Resize(1, 15).Cut Destination:=subsheet.Cells(i + 56, "B")
                .Rows(i).Resize(1, 15).Delete    '~~> if you want to delete
            End If
        Next
    End With
End Sub