VBA запустить макрос, затем l oop через другие листы

Question

Я пытаюсь (и не могу) заставить некоторый код запускаться на каждом листе, кроме одного указанного c листа. Я хочу, чтобы код просто вырезал данные в ячейках n2: s2 и вставил их в t1: y1, а затем повторил для всех других строк, содержащих данные в столбцах n3: s3, n4: s4, n5: s5.

Когда данных нет (строка 6, я считаю), они должны перейти на следующий лист (кроме листа «Отчет»). Проблема, с которой я сталкиваюсь, когда я отлаживаю, это перемещает данные, как ожидалось, затем запускается снова на том же листе, поэтому перезаписывает данные пустыми ячейками.

Sub MovethroughWB()

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop

        If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)

            Range("N2:S2").Select
            Selection.Cut Destination:=Range("T1:Y1")
            Range("T1:Y1").Select
            Range("N3:S3").Select
            Selection.Cut Destination:=Range("Z1:AE1")

        End If

    Next ws

End Sub

Я уверен, что это что-то базовое c, но не могу найти что!

Answer 1

Попробуйте:

Sub MovethroughWB()

    Dim ws As Worksheet
    Dim i  As Long, Lastrow As Long, Lastcolumn As Long

    For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop
        If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)
            With ws
                Lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
                For i = 2 To Lastrow
                    If .Range("N" & i).Value <> "" And .Range("O" & i).Value <> "" And .Range("P" & i).Value <> "" _
                        And .Range("Q" & i).Value <> "" And .Range("R" & i).Value <> "" And .Range("S" & i).Value <> "" Then
                        If .Range("T1").Value = "" Then
                            .Range("N" & i & ":S" & i).Cut .Range("T1:Y1")
                        Else
                            Lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                            .Range("N" & i & ":S" & i).Cut .Range(.Cells(1, Lastcolumn), .Cells(1, Lastcolumn + 5))
                        End If
                    End If
                Next i

                .Rows("2:" & Lastrow).EntireRow.Delete

            End With

        End If

    Next ws

End Sub