Hi Caveman,

Try this code. You may need to change the sheet references and/or column references if I misinterpreted your sample. Otherwise, it seems to work fine on my machine.

Hope this helps,

Ben

Code:


Sub ParseData()
Dim lRow As Long
Dim sCol(1 To 5) As String
Dim lCol(1 To 5) As Long
Dim x As Long

'This sub will copy all pertinent data from the SS tab and copy it
'to two other tabs. Then, the sub will delete any unnecessary rows
'from these two tabs.

Application.ScreenUpdating = False 'Speeds up macro

'Last row of data on SS tab
lRow = Sheet8.Range("A50000").End(xlUp).Row

'Set the column references for the SS tab
sCol(1) = "F"
sCol(2) = "G"
sCol(3) = "E"
sCol(4) = "L"
sCol(5) = "N"

'Set the column reference number for the Users tab
lCol(1) = 1
lCol(2) = 2
lCol(3) = 4
lCol(4) = 5
lCol(5) = 6

'Copy data to tabs (Note: only copying the pertinent columns)
For x = 1 To 5
Sheet8.Range(sCol(x) & "2:" & sCol(x) & lRow).Copy
Sheet4.Range(Cells(2, lCol(x)).Address, Cells(lRow, lCol(x)).Address).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x

'Delete unused rows
For x = lRow To 2 Step -1
If Sheet8.Range(Cells(x, 3).Address).Value = "7945" And _
Sheet8.Range(Cells(x, 8).Address).Value = "Yes" Then
'Do nothing
Else
Sheet4.Range(x & ":" & x).Delete (xlUp)
End If
Next x

'Repeat for NoVM tab
lCol(1) = 1
lCol(2) = 2
'lCol(3) = 4 'Not used
lCol(4) = 5
lCol(5) = 6

'Copy data to tabs (Note: only copying the pertinent columns)
For x = 1 To 5
Sheet8.Range(sCol(x) & "2:" & sCol(x) & lRow).Copy
If x < 3 Then Sheet5.Range(Cells(2, lCol(x)).Address, Cells(lRow, lCol(x)).Address).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x

'Delete unused rows
For x = lRow To 2 Step -1
If Sheet8.Range(Cells(x, 3).Address).Value = "7945" And _
Sheet8.Range(Cells(x, 8).Address).Value = "No" Then
'Do nothing
Else
Sheet5.Range(x & ":" & x).Delete (xlUp)
End If
Next x

Application.ScreenUpdating = True

End Sub