Macro: Copy entire column into new sheets based on criteria listed in range in another sheet AND also first 4 columns copied onto new sheet

[RyndaRaw]

Original Post here: Macro: Copy entire column into new sheets based on criteria listed in range in another sheet (excel 2010) | MrExcel Message Board

Macro should execute on command.

I realized I also need all rows for the description columns (Desc 1 to 4 are Columns A to D) to get returned with the columns (that matched the names from the approved tab).

1st Sheet - Input Sheet
- Input Sheet looks like below and rows go to ~ line 200,000
- it also has ~ 300 names in the columns after the Description

Desc 1	Desc 2	Desc 3	Desc 4	Name 1	Name 2
Red	Wide	Tall	Polka

2nd Sheet - Approved Names
This sheet will list names that should be copied to the 3rd sheet

Approved Name
Name 1
Name 4

3rd sheet (where all changes need to be copied to):

Should look like the below.
- Entire column for all Description attributes (Col A to D) should be copied over, starting at cell A1, including the header
- The entire columns with names in row 1, that match those on the approved sheet will be copied over to this sheet, should start after the last description column (in this case starts in column E)

Desc 1	Desc 2	Desc 3	Desc 4	Name 1	Name 4
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka	X	X
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka		X
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka	X
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka
Red	Wide	Tall	Polka

JWhiz Provided this macro but it's not copying the entire description columns to the new sheet. It is copying the approved columns starting in cell B1.

Sub at()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range
Set sh1 = Sheets("Input")
Set sh2 = Sheets("Approved Name")
Set sh3 = Sheets("Return Approved Names")
With sh1
For Each c In .Range("E1", .Cells(1, Columns.Count).End(xlToLeft))
If Application.CountIf(sh2.Range("A:A"), c.Value) > 0 Then
Intersect(c.EntireColumn, .UsedRange).Copy sh3.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
End If
Next
End With
End Sub