Hi

Look at this. I only changed it for FromWks.

Sub CADFixtureTable()
Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim RngToFilter As Range
Dim RngToCopy As Range
Dim LastCol As Long

Set FromWks = Worksheets("fixture counts")
Set ToWks = Worksheets("CAD Fixture Schedule")

ToWks.Range("A3:F500").ClearContents

With FromWks
.AutoFilterMode = False
LastCol = .Cells(14, Columns.Count).End(xlToLeft).Column
Set RngToFilter = .Range(.Cells(LastCol - 4), .Cells(.Rows.Count,
LastCol - 4).End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<"

If .AutoFilter.Range.Columns(1).Cells.SpecialCells
(xlCellTypeVisible) _
.Cells.Count = 1 Then

Else
With RngToFilter
Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, -1)
End With
RngToCopy.Copy
ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues
Sheets("Fixture Counts").Range("$AF$14:$AF$91").AutoFilter
Field:=1
'ToWks.Select
End If
End With
End Sub

Regards,
Per

On 30 Sep., 16:22, Scott wrote:
I currently have the code below which only looks at AF:14 to filter data. *I
would like to add/delete data... so I need the code to find the last column
with data and filter 4 cells left of that. * EX.. Currently AJ has last data
so needs to read AF:14 but if add 2 columns need to look at AM and filter
AH:14

Sub CADFixtureTable()

* * Dim FromWks As Worksheet
* * Dim ToWks As Worksheet
* * Dim RngToFilter As Range
* * Dim RngToCopy As Range

* * Set FromWks = Worksheets("fixture counts")
* * Set ToWks = Worksheets("CAD Fixture Schedule")

* * ToWks.Select
* * Range("A3:F500").Select
* * Selection.ClearContents

* * With FromWks
* * * * .AutoFilterMode = False

* * * * Set RngToFilter = .Range("AF14", .Cells(.Rows.Count, "AF").End(xlUp))
* * * * RngToFilter.AutoFilter Field:=1, Criteria1:="<"

* * * * If
.AutoFilter.Range.Columns(1).Cells.SpecialCells(xl CellTypeVisible) _
* * * * * .Cells.Count = 1 Then

* * * * Else
* * * * * * With RngToFilter

* * * * * * * * Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, -1)
* * * * * * End With

* * * * * *RngToCopy.Copy
* * * * * *ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues

* * * * Sheets("Fixture Counts").Select
* * * * ActiveSheet.Range("$AF$14:$AF$91").AutoFilter Field:=1

* * * * ToWks.Select
* * * * End If
* * End With

End Sub