简体   繁体   中英

VBA to run macro then loop through other sheets

I'm trying (and failing) to get some code to run on each worksheet except one specific sheet. I want the code to just cut the data in cells n2:s2 and paste it in t1:y1, then repeat for any other rows that have data in columns n3:s3, n4:s4, n5:s5.

Once there is no data (row 6 i believe), it should move onto the next sheet (except "Report" sheet). The problem i'm facing when i debug is it moves the data as expected, then starts again on the same sheet, so overwrites data with empty cells.

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

I'm sure its something basic, but can't find what!

Try:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM