I think it would be easier to keep the headings in a range instead of an array.
And I changed some variable names to make it easier for me to remember what's
being done:

Option Explicit
Sub InsertHeadings()
Dim Headers As Range
Dim LastCol As Long
Dim iCol As Long
Dim res As Variant

Set Headers = ThisWorkbook.Worksheets("List").Range("A1:BN1")

With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For iCol = LastCol To 1 Step -1
res = Application.Match(.Cells(1, iCol).Value, Headers, 0)
If IsError(res) Then
.Columns(iCol).Delete
Else
Headers(res).Offset(3, 0).Copy _
Destination:=.Cells(1, iCol)
End If
Next iCol
End With
End Sub




Les Stout wrote:

Hello all, i have a sheet that i need to delete unwanted columns and
then the wanted columns i need to put in English headings as the
original is in german. I use the formula below to get the columns to
delete from a list.
This works fine and wondered if it could be modified to copy the English
heading in row 4 of the sheet list & paste it into row 4 of the other
document ??

Sub InsertHaeadings()
Dim vList As Variant, lastCol As Long
Dim i As Long, res As Variant


vList = ThisWorkbook.Worksheets("List").Range _("A1:BN1").Value
For i = 160 To 1 Step -1
res = Application.Match(Cells(1, i), vList, 0)
If IsError(res) Then
Columns(i).Delete
Else
???? = If not deleted then copy
???? = and past
End If
Next

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

--

Dave Peterson