Copy rows based on criteria

[radka.silva]

Hello,

there seems to be quite a bit of posts on this subject, but still even sifting though them and modifying my code, it still doesn't want to work. :(

Data points:

My workbook has several tabs; First tab is called 'Original' - my original data is pasted here (data from a different source). Following tabs are called 'ADR', 'Global', 'LCV', 'SCV', ...

Tab 'Original' lists all account numbers and the strategy is listed in column E like this:


11200
11200 Account xyz
859386.56
8.3
ADR



I would like all the rows whos strategies are listed as ADR copied to a tab called ADR, all rows that list strategy Global copied to tab called Global, and so on. Here is the code I have so far (spliced and diced from other posts):

Sub PastetoTabs()
Dim Cell As Range
Dim WS As Worksheet
Dim LR As Long
Application.ScreenUpdating = False
For Each WS In Worksheets
Application.DisplayAlerts = False
If WS.Name = "Result" Then WS.Delete
Application.DisplayAlerts = True
Next WS

ActiveSheet.Activate

For Each Cell In Range("E11:E700")
If Cell = ADR Then
Cell.EntireRow.Copy
LR = Sheets("ADR").Range("A" & Rows.Count).End(xlUp).Row + 1
If IsEmpty(Sheets("ADR").Range("A3")) Then Sheets("ADR").Range("A3").PasteSpecial xlPasteAll: GoTo 1
Sheets("ADR").Range("A" & LR).PasteSpecial xlPasteAll
End If
1 Next Cell
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

System: Excel 2010

Thank you very much!

[p45cal]

try:
Sub PastetoTabs()
Dim Cell As Range
Dim WS As Worksheet
Dim LR As Long
Application.ScreenUpdating = False
'For Each WS In Worksheets
' Application.DisplayAlerts = False
' If WS.Name = "Result" Then WS.Delete
' Application.DisplayAlerts = True
'Next WS

For Each Cell In Range("E11:E700")
Set WS = Nothing
On Error Resume Next
Set WS = Sheets(Cell.Value)
On Error GoTo 0
If Not WS Is Nothing Then
LR = Application.Max(3, WS.Range("A" & WS.Rows.Count).End(xlUp).Row + 1)
Cell.EntireRow.Copy WS.Range("A" & LR)
End If
Next Cell
Application.ScreenUpdating = True
End Sub
If there exists a sheet called whatever's in the cell in column E, the entire row will be copied to that sheet.

[radka.silva]

Thank you so much p45cal! It works like a charm!