Hi,

Codes below copied from the forum are adjusted to suit my need but I
have a problem to run the codes each time will open an excel file
which will take a few minutes particularly when there are 20 excel
files.

Is there a better way to run the codes without opening the excel file
and save the changes in another folder ? so that I do not have to
spend much time to run 20 excel files


Sub ChgHeader()

Application.Calculation = xlCalculationManual

Dim wb As Workbook
Dim WBName As String
Dim WhatFolder As String

WhatFolder = "M:\CA\SP\Bdgt\BAl\dem3\"
ChDrive WhatFolder
ChDir WhatFolder
WBName = Dir("*.xls", vbNormal)
Do Until WBName = vbNullString
ChDir "M:\CA\SP\Bdgt\BAl\dem3"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = Workbooks.Open(WBName)
wb.Worksheets("P+L").Select
Dim i As Long
Dim Lstrow As Long
Lstrow = Cells(Rows.Count, "A").End(xlUp).Row
If Lstrow 0 Then
For i = 5 To Lstrow
If Cells(i, 1).Value < "" Then
Cells(i, 1).Copy
Cells(i, 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False

End If
Next
Else
MsgBox "It appears that the file is empty, check the file again"
Exit Sub
End If
ChDir "M:\CA\SP\Bdgt\BAl\dem4"
wb.SaveAs Filename:=Left(WBName, InStrRev(WBName, ".") - 1),
FileFormat:=xlNormal

wb.Close SaveChanges:=True
WBName = Dir()
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Application.EnableEvents = True

End Sub

Any helps will be much appreciated as I'm beginner to vba prog


Regards
Len