Copy and Paste Filtered cells in VBA

[chromosome1984]

Description	Type	Topper	Base Layer	A	A1	B	B1	C	D	D1	TRUCK
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	H1-NG2	H1						1		CPU
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	P1-DG34	H1					1	1		CPU
7.5 FE 4" WIDE	YELLOW DD 714(886) FE 8" IWC/SPLIT	H1-KG12	H1					1			CPU
7.5 FE 4" WIDE	YELLOW DD 714(886) FE 8" IWC/SPLIT	P1-KG12	H1	1							CPU
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	DG34	H1					2			CPU
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	H1-H1	H1					1			CPU
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	P1-DG34	H1					2			CPU
FE	532 FE	SYP-H1	SYP-BSP	4		3		13			E01
FE	532 FE	SYP-P275	SYP-BSP			4					E01
FE	PINK 700(814) FE ADJ CWC 6"	SYP-P1	SYP-BSP			1		1			E01
FE	PINK 700(814) FE ADJ CWC 6"	SYP-SW12	SYP-BSP	2		2		8			E01
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	DG34	H1	1							E02
7.5 FE 4" WIDE	ORANGE 840(1008 ) FE JOEY 8"	H1-H1	H1						2		E02

<colgroup><col><col><col><col><col><col span="2"><col><col><col><col><col></colgroup><tbody>
</tbody>

Hello All,

Below is the code that I am using to get the o/p i need from an ERP dump to clean and make the file usable.
Sub Cleaner_FE()
'
' Cleaner_FE Macro
'


'
Columns("A:A").EntireColumn.AutoFit

'text to columns

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(25, 1), Array(60, 1), Array(73, 1), Array(88, 1), _
Array(92, 1), Array(95, 1), Array(99, 1), Array(101, 1), Array(106, 1), Array(109, 1), _
Array(113, 1), Array(116, 1), Array(120, 1), Array(122, 1), Array(127, 1), Array(130, 1), _
Array(134, 1)), TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit

'deleting empty or non useful cells

Columns("R:AD").Select
Selection.Delete Shift:=xlToLeft
Columns("P:P").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("B:B").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:= _
"<>*truck*", Operator:=xlAnd, Criteria2:="<>*cpu*"
Selection.ClearContents
Rows("1:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Columns("C:C").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$731").AutoFilter Field:=1, Criteria1:= _
"<>*6"" IWC EDGE*", Operator:=xlAnd, Criteria2:="<>*7.5 FOAMEDGE 4"" WIDE*"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Delete"
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.End(xlDown).Select
Columns("B:B").Select
ActiveSheet.Paste
Range("B2").Select
ActiveSheet.Range("$A:$T").AutoFilter Field:=1, Criteria1:="=*foam edge*", _
Operator:=xlAnd
Range("B24").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Keep"
Range("B24").Select
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste
ActiveSheet.Range("$A:$T").AutoFilter Field:=1
ActiveSheet.Range("$A:$T").AutoFilter Field:=2, Criteria1:="Delete"
Cells.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("C1").Select



'Cleaning Truck Name & Route

Dim LR1 As Long
LR1 = ActiveSheet.UsedRange.Rows.Count
Range("L1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(LEFT(RC[-9],5),3)"
Range("L1").Select
Selection.AutoFill Destination:=Range("L1:L" & LR1)


'insert a new row for headers

Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'naming the headers

Range("A1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Top"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Base"
Range("E1").Select
ActiveCell.FormulaR1C1 = "T"
Range("F1").Select
ActiveCell.FormulaR1C1 = "T1"
Range("G1").Select
ActiveCell.FormulaR1C1 = "F"
Range("H1").Select
ActiveCell.FormulaR1C1 = "F1"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Q"
Range("J1").Select
ActiveCell.FormulaR1C1 = "K"
Range("K1").Select
ActiveCell.FormulaR1C1 = "k1"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Truck"
Range("A2").Select
End Sub



The issue i am running into is that this code is using the entire column as the range and making the code slow. Would like to improve this better.

I am not able to successfully copy and paste value of filtered cells into a new column either.

Please help me resolve this...

K