VBA - Copy into other sheets based on keyword

[bvherrera]

Hello everyone!

For my line of work I work with lots of data (currently 10,000+ cells over 7 columns and counting!). Unfortunately, I am no good with VBA.

I had the following code made for me by the helpful elmer007:

Public Sub CopyRows()

'Counts for number of rows on Sheet2 and Sheet3
Dim dCount, rCount As Long
wCount = Application.WorksheetFunction.CountA(Sheets("TRANSF").Range("A:A"))
aCount = Application.WorksheetFunction.CountA(Sheets("SURPLUS").Range("A:A"))
sCount = Application.WorksheetFunction.CountA(Sheets("LOST").Range("A:A"))
dCount = Application.WorksheetFunction.CountA(Sheets("NO CMDB").Range("A:A"))


'Range to be used to traverse data on Sheet1
Dim myRange As Range
Set myRange = Sheets("Sheet1").Range("A1")




'Check every row until an empty row
Do Until IsEmpty(myRange)


    'If disposed, put values on Sheet2
    If InStr(1, UCase(myRange.Offset(0, 4)), "TRANSF") Then
        Sheets("TRANSF").Cells(wCount + 1, 1).Resize(5, 7).Value = myRange.Resize(5, 7).Value
        wCount = wCount + 1
    End If
    
    'If respon party, put values on Sheet3
    If InStr(1, UCase(myRange.Offset(0, 4)), "SURPLUS") Then
        Sheets("SURPLUS").Cells(aCount + 1, 1).Resize(5, 7).Value = myRange.Resize(5, 7).Value
        aCount = aCount + 1
    End If
    
        'If not found, put values on Sheet3
    If InStr(1, UCase(myRange.Offset(0, 4)), "LOST") Then
        Sheets("LOST").Cells(sCount + 1, 1).Resize(5, 7).Value = myRange.Resize(5, 7).Value
        sCount = sCount + 1
    End If
    
        'If respon party, put values on Sheet3
    If InStr(1, UCase(myRange.Offset(0, 4)), "NO CMDB") Then
        Sheets("NO CMDB").Cells(dCount + 1, 1).Resize(5, 7).Value = myRange.Resize(5, 7).Value
        dCount = dCount + 1
    End If
    
    'Move range down one row
    Set myRange = myRange.Offset(1, 0)
    
Loop


End Sub

The problems:

1. Currently, this code copies columns A-G into the specified sheet. I want only columns E-G copied over
2. I want the information copied to start on the second line, as opposed to the first, to be able to put headers over the data.
3. When the code ends, it copies the last 4 rows of data after the final keyword-containing row, regardless of the specific data in them.
4. Is there any way to copy over the rows that have any character, number, or phrase in column E, regardless of what it is, into a new sheet labeled "Not Found"?

Attached are examples of what it looks like currently, and what I want it to look like (minus headers in the other sheets). https://drive.google.com/file/d/0B3wQulJjDPsnYnVZanM5TS1nYlk/view?usp=sharing

Thank you all!

 

[Peter_SSs]

My code reads the original data into memory and collects all the results into an array, also in memory, before finally writing those results onto the individual sheets. This process should make the code much faster that the original, espacially if you ahve a largish data set.

The approach is to put all the results into a single array, with 3 columns allowed for each result sheet.
For each additional sheet, this line needs to add the sheet name, a 1 and nothing, separated by commas. The 1 is a starting row for results for that sheet and gets increased during the code. The nothing is just a filler to match the 3 columns per result sheet as the red part at the end splits that string into an array by splitting it at each comma in the string. So to add extra sheets

aShts = Split("TRANSF,1,,SURPLUS,1,,LOST,1,,NO CMDB,1,,NOT FOUND,1,,EXTRA SHT 1,1,,EXTRA SHT 2,1,,", ",")

In the 'Select Case' section, the k values just increase by 3 each time, again because there are 3 columns per result sheet.