CopyRow help for multiple tabs

[addamz]

Hello! I have a spreadsheet with multiple tabs, and need to copy data from one tab to other tabs, depending on key words in column K. I have the code below that works for one, but need to know how to change it from one to multiple different search criteria and copying to multiple tabs. This copies anything with "Mazak" in column K to the Mazak tab. There are other tabs, Lathe, SL30, Fadal, etc. How can i change the script to search for each of those and copy rows to the correlating tabs? Thanks in advance!!


Sub CopyRow()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Pop").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long
x = 3
Dim rng As Range
For Each rng In Sheets("Pop").Range("K3:K" & LastRow)
If rng = "Mazak" Then
rng.EntireRow.Copy
Sheets("Mazak").Cells(x, 1).PasteSpecial xlPasteValues
x = x + 1
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[offthelip]

Try this, note I have NOT tested this!!!
Note also I have loaded column K into a variant array, this is because this will really speed up this macro, because you have a multiple loop your a looping through worksheet pop column K and then also through all the worksheet.




Sub copyrow2()

Application.ScreenUpdating = False
Dim LastRow As Long
Dim ws As Worksheet
LastRow = Sheets("Pop").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long


Dim Inarr As Variant
' load worksheet pop into memory
Inarr = Worksheets("Pop").Range("K1:K" & LastRow)
For Each ws In ActiveWorkbook.Worksheets
x = 3
If ws.Name <> "Pop" Then
For i = 3 To LastRow


If Inarr(i, 1) = Ws.Name Then
Worksheets("pop").Range(i, 1).EntireRow.Copy
ws.Cells(x, 1).PasteSpecial xlPasteValues
x = x + 1
End If
Next i

Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub