1819
06-26-2016, 04:17 AM
The code below comes from
http://stackoverflow.com/questions/24632623/move-row-to-another-worksheet-where-cell-equals-worksheet-name.
It works to move rows that match the name of a worksheet to that worksheet.
Please could someone suggest how to amend it to achieve this: (in pseudocode)
If a cell contains a word which matches the name of worksheet, move the row to that worksheet.
Work in the order of the worksheets so that if there is a duplicate, move to the first match.
So if you had "Vote Leave or Remain" in the cell, and "Leave" and "Remain" as worksheets, the row would be moved to "Leave".
Ideally I would like the code to be able to cope with dynamic worksheet names (that is, not having to write in the worksheets' names in the code)
Sub Main()
Sheets("All Data").Activate
Range("A2").Activate
Dim SheetToPaste As String
Do While ActiveCell.Value <> ""
Select Case ActiveCell.Value
Case "Hoja2"
SheetToPaste = "Hoja2"
Case "Hoja3"
SheetToPaste = "Hoja3"
Case Else
SheetToPaste = "Mismatch"
End Select
ActiveCell.EntireRow.Copy
Sheets(SheetToPaste).Activate
Range("A2").Activate
ActiveCell.EntireRow.Insert
Application.CutCopyMode = False
Sheets("All Data").Activate
ActiveCell.EntireRow.Delete
Loop
End Sub
Thanks!
http://stackoverflow.com/questions/24632623/move-row-to-another-worksheet-where-cell-equals-worksheet-name.
It works to move rows that match the name of a worksheet to that worksheet.
Please could someone suggest how to amend it to achieve this: (in pseudocode)
If a cell contains a word which matches the name of worksheet, move the row to that worksheet.
Work in the order of the worksheets so that if there is a duplicate, move to the first match.
So if you had "Vote Leave or Remain" in the cell, and "Leave" and "Remain" as worksheets, the row would be moved to "Leave".
Ideally I would like the code to be able to cope with dynamic worksheet names (that is, not having to write in the worksheets' names in the code)
Sub Main()
Sheets("All Data").Activate
Range("A2").Activate
Dim SheetToPaste As String
Do While ActiveCell.Value <> ""
Select Case ActiveCell.Value
Case "Hoja2"
SheetToPaste = "Hoja2"
Case "Hoja3"
SheetToPaste = "Hoja3"
Case Else
SheetToPaste = "Mismatch"
End Select
ActiveCell.EntireRow.Copy
Sheets(SheetToPaste).Activate
Range("A2").Activate
ActiveCell.EntireRow.Insert
Application.CutCopyMode = False
Sheets("All Data").Activate
ActiveCell.EntireRow.Delete
Loop
End Sub
Thanks!