CODEWITHSUNDEEP
vbaexcel
SMORF
SMORF

Reputation: 499

Copy row where cell matches worksheet name

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

Upvotes: 0

Views: 2155

Answers (2)

Chrismas007
Chrismas007

Reputation: 6105

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

Upvotes: 1

Gary's Student
Gary's Student

Reputation: 96753

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

Upvotes: 0

Related Questions