0

I have the following code that moves rows to a specific worksheet where a cell value in column M is equal to value: 'not planned'

Sub Not_Planned()

Sheets("All Data").Select

RowCount = Cells(Cells.Rows.count, "a").End(xlUp).Row

For i = 1 To RowCount

    Range("M" & i).Select
    check_value = ActiveCell

    If check_value = "not planned" Then
        ActiveCell.EntireRow.Copy
        Sheets("Not Planned").Select
        RowCount = Cells(Cells.Rows.count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("All Data").Select
        Range("A2").Select
    End If

Next

End Sub

Is there a way to adapt the code so it runs through all rows and copies the row to a worksheet where the value in column A is equal to a worksheet name ?

Please note: I already have a code that creates worksheets and names them as per unique values in column A.

Thanks

Chrismas007
  • 6,085
  • 4
  • 24
  • 47
SMORF
  • 499
  • 6
  • 13
  • 30

2 Answers2

1

Edited... Apparently you CAN use RowCount twice and change it mid-loop. Not good practice as the variable is being sourced in two different sheets, but it technically will work.

First off STOP USING SELECT

Second this should do it (only if you want to move "not planned" items to a different sheet):

Sub Not_Planned()

Dim DataSht As Worksheet, DestSht As Worksheet

Set DataSht = Sheets("All Data")

RowCount = DataSht.Cells(Cells.Rows.count, "A").End(xlUp).Row

For i = 2 To RowCount

    check_value = DataSht.Range("M" & i).Value

    If check_value = "not planned" Then
        DataSht.Range("M" & i).EntireRow.Copy
        Set DestSht = Sheets(DataSht.Range("A" & i).Value)
          'You might want some error handling here for if the Sheet doesn't exist!
        DestLast = DestSht.Cells(Cells.Rows.count, "a").End(xlUp).Row
        DestSht.Range("a" & DestLast + 1).Paste
    End If

Next i

End Sub

If you want to run the "planned" after your "not planned" macro then:

Sub Planned()

Dim DataSht As Worksheet, DestSht As Worksheet

Set DataSht = Sheets("All Data")

RowCount = DataSht.Cells(Cells.Rows.count, "A").End(xlUp).Row

For i = 2 to RowCount
        DataSht.Range("A" & i).EntireRow.Copy
        Set DestSht = Sheets(DataSht.Range("A" & i).Value)
          'You might want some error handling here for if the Sheet doesn't exist!
        DestLast = DestSht.Cells(Cells.Rows.count, "a").End(xlUp).Row
        DestSht.Range("a" & DestLast + 1).Paste
Next i

End Sub
Community
  • 1
  • 1
Chrismas007
  • 6,085
  • 4
  • 24
  • 47
0

This version ignores column M and uses column A instead:

Sub Not_Planned()

Sheets("All Data").Select

RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row

For i = 1 To RowCount
    DestinationSheet = Range("A" & i).Value

        ActiveCell.EntireRow.Copy
        Sheets(DestinationSheet).Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("All Data").Select
        Range("A2").Select

Next

End Sub
Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • 1
    1. [STOP USING SELECT](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) and 2. he said it needs to check M for "not planned". – Chrismas007 Jan 07 '15 at 15:50
  • @Gary's Student - I get a 'Substring out of range' error on line 'Sheets(DestinationSheet).Select' ... any ideas ? – SMORF Jan 07 '15 at 16:13
  • @SMORF.......... This usually means that there is a spelling error somewhere and the variables in column **A** do not exactly match the tabnames. – Gary's Student Jan 07 '15 at 16:28
  • @Gary'sStudent ... when I hover over the 'DestinationSheet' it shows me 'CUNR' which is the column A header ... how can I start the code at row 2 and ignore the column header? – SMORF Jan 07 '15 at 16:39
  • 1
    @SMORF `i = 2 to RowCount` – Chrismas007 Jan 07 '15 at 16:40
  • @Gary'sStudent ... this code duplicates row 2 on each worksheet the same amount of times as the count of each column A value ? – SMORF Jan 07 '15 at 17:06