اهلا استاذى ياسر
ادخلت علي السرور بردك لانى كنت متخيل ان الموضوع مستحيل
لقد قمت بالتعديل على الكود ليتناسب مع التعديلات التى اريدها ، لكن ظهر خطأ عند تشغيل الماكرو
Option Explicit
Sub LoopThroughClosedWBs()
Dim WBK As Workbook
Dim FolderPath As String
Dim FileName As String
Dim Counter As Double
FolderPath = ThisWorkbook.Path & "\"
FileName = Dir(FolderPath & "*.xl*")
Application.ScreenUpdating = False
Application.Calculation = xlManual
Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then
Set WBK = Workbooks.Open(FolderPath & FileName)
With WBK.Sheets("1")
.Range("g2").Formula = "=MAX(H:H)"
.Range("g6").Formula = "=SUMIF(E6;>=0)"
.Range("h6").Formula = "=IF(E6=G6;F6;"")"
.Columns("g:h").Hidden = True
End With
WBK.Close SaveChanges:=True
End If
FileName = Dir()
Loop
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "Finished ...", 64
End Sub