0

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!

Error 1004
  • 7,877
  • 3
  • 23
  • 46
SPSGN
  • 3
  • 4
  • 1
    after `if` use `With ws` and before `End if` use `End With` in other case Excel is doing everything in active sheet – Teamothy Feb 13 '20 at 09:38
  • wow - i think it worked - just testing it now - thanks Teamothy – SPSGN Feb 13 '20 at 09:49
  • 1
    And read this https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – SJR Feb 13 '20 at 09:52
  • I spoke too soon..not sure what is going on but its not working again :( My code is Sub MovethroughWB2() 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) With ws 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 With End If Next ws End Sub – SPSGN Feb 13 '20 at 10:39

1 Answers1

1

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
Error 1004
  • 7,877
  • 3
  • 23
  • 46
  • Thanks so much for the code - it kind of worked....I need it to move the data i n2:s2 to t1:y1 and the data from n3:s3 to z1:ae1, so all data resides on row 1, and then i will delete rows 2&3 etc – SPSGN Feb 13 '20 at 10:43
  • How would it on the end to delete all but row 1 before it moves onto the next sheet? – SPSGN Feb 13 '20 at 15:42