Maybe starting with:

ws1.range("C6:C" & ws1.rows.count).Copy _
Destination:=Range("L1")

And make sure that DatabaseAll points at what you want.

David wrote:

Well...it would help if you had the code...LOL!!
The data I'm looking at starts at Row 6 (6 is the header), with the filtered
data staring on 7 onward....I'm dying here!!

Option Explicit
Sub ExtractReps()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim wCtr As Long

Worksheets("sheet1").Visible = xlSheetVisible
Sheets("All_Jobs").Activate

Set ws1 = Sheets("All_Jobs")

Set rng = Range("DatabaseAll")
'Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").Copy _
Destination:=Range("L1")
ws1.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
Range("L1").Value = Range("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name to the criteria area
ws1.Range("L2").Value = c.Value

'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("All_Jobs").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set WSNew = Sheets.Add
WSNew.Move After:=Worksheets(Worksheets.Count)
WSNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("All_Jobs").Range("L1:L2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
End If

Next

"Dave Peterson" wrote:

Try recording it as you select the range
then Data|Filter|autofilter.

I have no idea what ApplyFilter in payroll combo.xls actually does.

And this line is gonna cause trouble


David wrote:

I recorded it, got one line which I put at the front...no go. Here's what I
have:

Sub MoveData()
Dim rng As Range

Application.Run "'Payroll Combo.xls'!ApplyFilter" '<<< New Line
Set rng = ActiveSheet.AutoFilter.Range
If rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("sheet1").Range("A2")
Else
MsgBox "No visible data"
End If

End Sub

I'm trying some new code to try and do the same thing, but not getting any
results, although it seems to be working. Maybe this is a better alternative,
if I can get it to work:
Sub CopyData()

Dim lRow As Long 'Last Row
Dim nRow As Long 'Next Row to copy to
Dim cnt As Long

lRow = Sheets("All_Jobs").Range("A" & Sheets("All_Jobs").Rows.Count).End(xlUp)
With Sheets("All_Jobs")
For cnt = 7 To lRow '<<<Data starts on Row 7
If .Range("A" & cnt) = ("FilterCriteria") Then '<<FilterCriteria is the
named range of two cells with a start date - end date, without the headers. I
THINK THE PROBLEM IS HERE!!
nRow = Sheets("sheet1").Range("A" & _
Sheets("sheet1").Rows.Count).End(xlUp).Offset(1, 0).Row
.Range("A" & cnt).Copy Sheets("sheet1").Range("A" & nRow + 1) '<< I
need to start the paste on Row 2. Row 1 has headers.
End If
Next
End With

End Sub

--

Dave Peterson


--

Dave Peterson